Delphi Get HDD Serial Number

Published 12/09/2011 | By obaby

 
program keygenme;
 
uses
Windows,Messages,CommCtrl;
 
{$R software.RES}
var WinClass: TWndClassA;
Inst: HINST;
hWindow: HWND;
TheMessage: TMsg;
 
hDrive:HWND;
hID:HWND;
hf:THandle;
 
htitle:HWND;
 
cmbChange: HWND;
cmbAbout: HWND;
cmbExit: HWND;
 
PaintStruct: TPaintStruct;
PaintDC: HDC;
hFont1: HFONT;
isNT:Boolean;
 
function StrToInt(const S: string):Integer;
var
E: Integer;
begin
Val(S, Result, E);
end;

 
function toString(Value: Integer): string;
var
f,x:integer;
str:string;
begin
f:=value;
repeat
x:=f and $F;
case (x) of
$0..$9: str:=char($30+x)+str;
$A..$F: str:=char($37+x)+str;
end;
if length(str)=4 then str:='-'+str;
f:=f shr 4;
until length(str)=9;
toString:=str;
end;
 
function FillSerial(buf,Num:dword):integer;
asm
push esi
mov esi,eax
//eax=buf
//edx=Serial
push edx
xor eax,eax
@@FAT32:
inc eax
mov edx,[esi+$52]
xor edx,$33544146
jnz @@FAT
movzx edx,byte ptr[esi+$56]
xor edx,$32
jnz @@FAT
pop edx
mov [esi+$43],edx//FAT32
jmp @@exit
@@FAT:
inc eax
mov edx,[esi+$36]
and edx,$00FFFFFF
xor edx,$544146
jnz @@NTFS
pop edx
mov [esi+$27],edx
jmp @@exit
@@NTFS:
inc eax
mov edx,[esi+3]
xor edx,$5346544E//NTFS
jnz @@Error
pop edx
mov [esi+$48],edx//NTFS
jmp @@exit
@@Error:
inc eax
pop edx
@@exit:
pop esi
end;
 
function LockDisk(DriverNum:dword;levelx:byte;Permissions:word):Boolean;
var
reg:record
reg_EBX:DWORD;
reg_EDX:DWORD;
reg_ECX:DWORD;
reg_EAX:DWORD;
reg_EDI:DWORD;
reg_ESI:DWORD;
reg_Flags:DWORD;
end;
pok:dword;
isOK:Boolean;
begin
reg.reg_EAX:=$440D;
reg.reg_EBX:=levelx*256+DriverNum;
reg.reg_ECX:=$484A;
reg.reg_EDX:=Permissions;
reg.reg_EDI:=0;
reg.reg_ESI:=0;
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
1,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
if (not isOK) then
begin
reg.reg_EAX:=$440D;
reg.reg_EBX:=levelx*256+DriverNum;
reg.reg_ECX:=$084A;
reg.reg_EDX:=Permissions;
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
1,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
end;
LockDisk:=isOK;
end;
 
function UnLockDisk(DriverNum:dword):Boolean;
var
reg:record
reg_EBX:DWORD;
reg_EDX:DWORD;
reg_ECX:DWORD;
reg_EAX:DWORD;
reg_EDI:DWORD;
reg_ESI:DWORD;
reg_Flags:DWORD;
end;
pok:dword;
isOK:Boolean;
begin
reg.reg_EAX:=$440D;
reg.reg_EBX:=DriverNum;
reg.reg_ECX:=$486A;
reg.reg_EDX:=0;
reg.reg_EDI:=0;
reg.reg_ESI:=0;
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
1,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
if (not isOK) then
begin
reg.reg_EAX:=$440D;
reg.reg_EBX:=DriverNum;
reg.reg_ECX:=$086A;
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
1,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
end;
UnLockDisk:=isOK;
end;
 
function HardRWV1(DriverNum:dword;pBuf:dword;rw:dword):Boolean;
var
reg:record
reg_EBX:DWORD;
reg_EDX:DWORD;
reg_ECX:DWORD;
reg_EAX:DWORD;
reg_EDI:DWORD;
reg_ESI:DWORD;
reg_Flags:DWORD;
end;
diskio:packed record
dwStartSector:DWORD; // 要读写的起始扇区号
wSectors:WORD; // 要读写的扇区数
dwBuffer:DWORD;
end;
pok:dword;
isOK:Boolean;
begin
diskio.dwStartSector:=0;
diskio.wSectors:=1;
diskio.dwBuffer:=dword(pBuf);
reg.reg_EAX:=DriverNum-1;
reg.reg_EBX:=DWORD(@diskio);
reg.reg_ECX:=$FFFF;
reg.reg_EDX:=0;
reg.reg_EDI:=0;
reg.reg_ESI:=0;
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
rw, //2:read,3:write
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
HardRWV1:=isOK;
end;
 
function HardRWV2(DriverNum:dword;pBuf:dword;rw:dword):Boolean;
var
reg:record
reg_EBX:DWORD;
reg_EDX:DWORD;
reg_ECX:DWORD;
reg_EAX:DWORD;
reg_EDI:DWORD;
reg_ESI:DWORD;
reg_Flags:DWORD;
end;
diskio:packed record
dwStartSector:DWORD; // 要读写的起始扇区号
wSectors:WORD; // 要读写的扇区数
dwBuffer:DWORD;
end;
pok:dword;
isOK:Boolean;
begin
diskio.dwStartSector:=0;
diskio.wSectors:=1;
diskio.dwBuffer:=dword(pBuf);
reg.reg_EAX:=$7305;
reg.reg_EBX:=DWORD(@diskio);
reg.reg_ECX:=$FFFF;
reg.reg_EDX:=DriverNum;
reg.reg_EDI:=0;
reg.reg_ESI:=rw; //6001:write,0:read
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
6,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
HardRWV2:=isOK;
end;
 
function ReadHardSec(DriverNum:dword;pBuf:dword):Boolean;
var
VerInfo:_OSVERSIONINFOA;
isOK:Boolean;
begin
GetVersionExA(VerInfo);
if VerInfo.dwBuildNumber &gt; $438 then
isOK:=HardRWV2(DriverNum,pBuf,$0)
else
isOK:=HardRWV1(DriverNum,pBuf,$2);
ReadHardSec:=isOK;
end;
 
function WriteHardSec(DriverNum:dword;pBuf:dword):Boolean;
var
VerInfo:_OSVERSIONINFOA;
isOK:Boolean;
begin
GetVersionExA(VerInfo);
if VerInfo.dwBuildNumber &gt; $438 then
isOK:=HardRWV2(DriverNum,pBuf,$6001)
else
isOK:=HardRWV1(DriverNum,pBuf,$3);
WriteHardSec:=isOK;
end;
 
function FloppySecRW(DriverNum:dword;pBuf:dword;rw:dword):Boolean;
var
reg:record
reg_EBX:DWORD;
reg_EDX:DWORD;
reg_ECX:DWORD;
reg_EAX:DWORD;
reg_EDI:DWORD;
reg_ESI:DWORD;
reg_Flags:DWORD;
end;
pok:dword;
isOK:Boolean;
begin
reg.reg_EAX:=rw*256+1; //ah=02:read,ah=03:write
reg.reg_EBX:=DWORD(pBuf);
reg.reg_ECX:=1;
reg.reg_EDX:=DriverNum-1;
reg.reg_EDI:=0;
reg.reg_ESI:=0;
reg.reg_Flags:=1;
isOK:=DeviceIoControl(hf,
4,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
FloppySecRW:=isOK;
end;
 
function FloppyEnd(DriverNum:dword):Boolean;
var
reg:record
reg_EBX:DWORD;
reg_EDX:DWORD;
reg_ECX:DWORD;
reg_EAX:DWORD;
reg_EDI:DWORD;
reg_ESI:DWORD;
reg_Flags:DWORD;
end;
pok:dword;
isOK:Boolean;
begin
reg.reg_EAX:=$440D;
reg.reg_EBX:=DriverNum;
reg.reg_ECX:=$849;
reg.reg_EDX:=0;
reg.reg_EDI:=0;
reg.reg_ESI:=0;
reg.reg_Flags:=0;
isOK:=DeviceIoControl(hf,
1,
@reg,
sizeOf(reg),
@reg,
sizeOf(reg),
pok,
nil);
isOK:=isOK and (not odd(reg.reg_Flags));
FloppyEnd:=isOK;
end;
 
procedure Change9x();
var
buf:array[1..512] of byte;
ErrMSG:String;
szDriver:String;
Driver:dword;
Serial:DWORD;
diskType:integer;
 
begin
setLength(szDriver,9);
GetWindowText(hID,PChar(szDriver),10);
Delete(szDriver,5,1);
Serial:=strtoint('$'+szDriver);
 
setLength(szDriver,2);
GetWindowText(hDrive,PChar(szDriver),3);
 
diskType:=GetDriveType(PChar(szDriver+'\'));
Driver:=ord(szDriver[1]);
 
hf:=CreateFile('\\.\vwin32',
0, //GENERIC_READ or GENERIC_WRITE,
0, //FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
0, //OPEN_EXISTING,
$4000000, //FILE_ATTRIBUTE_NORMAL,//$4000000,//DELETE_ON_CLOSE
0);
if hf&lt;&gt;$FFFFFFFF then
begin
case (diskType) of
2:begin //floppy
Driver:=Driver-$40;
if LockDisk(Driver,0,0) then
begin
if FloppySecRW(Driver,dword(@buf),2) then
begin
if FillSerial(dword(@buf),Serial)&lt;4 then
begin
if FloppySecRW(Driver,dword(@buf),3) then
begin
FloppyEnd(Driver);
UnLockDisk(Driver);
ErrMSG:='恭喜！！修改序列号成功！';
end else
ErrMSG:='错误！写磁盘错误！！';
end else
ErrMSG:='错误！磁盘格式不支持！！';
end else
ErrMSG:='错误！读磁盘错误！！';
end else
ErrMSG:='错误！锁定磁盘失败！！ ';
end;
3:begin //hard
Driver:=Driver-$40;
if LockDisk(Driver,1,1) and LockDisk(Driver,2,0) then
begin
if ReadHardSec(Driver,dword(@buf)) then
begin
if FillSerial(dword(@buf),Serial)&lt;4 then
begin
if WriteHardSec(Driver,dword(@buf)) then
begin
UnLockDisk(Driver);
UnLockDisk(Driver);
ErrMSG:='恭喜！！修改序列号成功！';
end else
ErrMSG:='错误！写磁盘错误！！';
end else
ErrMSG:='错误！磁盘格式不支持！！';
end else
ErrMSG:='错误！读磁盘错误！！';
end else
ErrMSG:='错误！锁定磁盘失败！！ ';
end
else
ErrMSG:='错误！不可操纵磁盘！！';
end;
CloseHandle(hf);
end else
ErrMSG:='无法打开VWIN32服务！！';
 
MessageBox(hWindow,PChar(ErrMSG),PChar(copy(ErrMSG,1,6)),0);
end;
 
procedure ChangeNT();
var
hf:THandle;
buf:array[1..512] of byte;
pok:dword;
Driver:string;
ErrMSG:string;
Serial:DWORD;
begin
setLength(Driver,9);
GetWindowText(hID,PChar(Driver),10);
Delete(Driver,5,1);
Serial:=strtoint('$'+Driver);
//Serial:=$88888888;
 
setLength(Driver,2);
GetWindowText(hDrive,PChar(Driver),3);
Driver:='\\.\'+Driver;
hf:=CreateFile(PChar(Driver),
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0);
if hf&lt;&gt;$FFFFFFFF then
begin
if ReadFile(hf,buf,512,pok,nil) then
begin
if FillSerial(dword(@buf),Serial)&lt;&gt;4 then
begin
SetFilePointer(hf,0,nil,0);
if WriteFile(hf,buf,512,pok,nil) then
begin
if pok&lt;&gt;512 then
ErrMSG:='错误！修改序列号不成功！'
else
ErrMSG:='恭喜！！修改序列号成功！';//写文件成功
end else begin
ErrMSG:='错误！写磁盘共享错误！！'
end;
end else begin
ErrMSG:='错误！磁盘格式不支持！！'
end;
end else begin
ErrMSG:='错误！读磁盘共享错误！！'
end;
CloseHandle(hf);
end else
begin
ErrMSG:='错误！打开磁盘共享错误！'
end;
MessageBox(hWindow,PChar(ErrMSG),PChar(copy(ErrMSG,1,6)),0);
setLength(Driver,0);
end;
 
procedure getDrive();
var
Device:Dword;
D:integer;
str:String;
begin
Device:=GetLogicalDrives;
D:=$40;
repeat
inc(D);
if odd(Device) then
begin
str:=char(D)+':';
SendMessage(hDrive,
CB_ADDSTRING,
0,
lParam(str)
);
end;
Device:=Device shr 1;
until Device=0;
SendMessage(hDrive,CB_SELECTSTRING,0,LParam(PChar('C:')) );
end;
 
procedure initSerial();
var
root:String;
serial:dword;
t1:dword;
begin
setLength(root,2);
GetWindowText(hDrive,PChar(root),3);
if not GetVolumeInformation(PChar(root+'\'),nil,0,@serial,t1,t1,nil,0) then
begin
serial:=0;
MessageBox(hWindow,'获取序列号失败','提示',0);
end;
setLength(root,0);
root:=toString(serial);
SetWindowText(hID,PChar(root));
end;
 
function WindowProc(hWindow: HWnd; Message,wParam,lParam: Integer): Integer; stdcall;
procedure DrawBox(hdc,x1,y1,x2,y2:integer);
begin
MoveToEx(hdc,x1,y1,nil);
LineTo(hdc,x1,y2);
LineTo(hdc,x2,y2);
LineTo(hdc,x2,y1);
LineTo(hdc,x1,y1);
end;
begin
Result := 0;
{ Checks for messages }
case Message of
WM_CREATE: begin
InitCommonControls;
end;
WM_SHOWWindow:begin
//getDrive;
end;
WM_COMMAND: begin
if ((HWND(lParam) = hDrive))then
begin
if (wparam=$90000) then initSerial;
end;
if HWND(lParam) = cmbChange then if isNT then ChangeNT() else Change9x();
if HWND(lParam) = cmbAbout then
MessageBox(hwindow,'Original CoDE bY DiKeN/iPB'#13#10#13#10'Latest Update bY heXer/iPB'#13#10#13#10'inside pandora''s Box'#13#10#13#10'http://www.ipbchina.org','磁盘序列号修改器 for WinALL',0);
if HWND(lParam) = cmbExit then SendMessage(hWindow,WM_DESTROY,0,0);
end;
 
WM_PAINT:begin
PaintDC := BeginPaint(hWindow,PaintStruct);
 
DrawBox(PaintDC,5,5,163,78);
DrawBox(PaintDC,7,59,161,76);
 
hFont1 := CreateFont(-11,0,0,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,0,0,0,0,'MS Sans Serif');
SelectObject(PaintDC,hFont1);
 
SetBkColor(PaintDC,GetSysColor(COLOR_BTNFACE));
SetTextColor(PaintDC,RGB($33,$99,$33));
TextOut(PaintDC,25,60,'inside Pandora''s Box',20);
SelectObject(PaintDC,hFont1);
end;
WM_DESTROY: begin
DeleteObject(hFont1);
PostQuitMessage(0);
Exit;
end;
else
Result := DefWindowProc(hWindow, Message, wParam, lParam);
end;
end;
 
begin
 
Inst := hInstance;
 
with WinClass do
begin
style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface +1;
lpszClassname := 'HID';
hIcon := 0;//
hCursor := LoadCursor(0,IDC_ARROW);
end; { with }
WinClass.hIcon:=LoadIcon(Inst,'MAINICON');
RegisterClass(WinClass);
//'MS Sans Serif'
hFont1:=CreateFont(-11,0,0,0,0,0,0,0,DEFAULT_CHARSET,0,0,0,0,'MS Sans Serif');
SelectObject(PaintDC,hFont1);
//Create Main Window =========
hWindow := CreateWindowEx(WS_EX_WINDOWEDGE,
'HID',
'序列号修改器',
WS_VISIBLE or WS_MINIMIZEBOX or WS_SYSMENU,
193,150,175,140,0, 0, Inst, nil);
htitle:=Createwindow('STATIC',
'驱动器:',
WS_VISIBLE or WS_CHILD or SS_LEFT,
12,10,50,15, hWindow, 0, Inst, nil);
SendMessage(htitle,WM_SETFONT,hFont1,0);
 
hDrive:= CreateWindow('COMBOBOX','C:\',WS_VISIBLE or WS_CHILD or CBS_DROPDOWNLIST or WS_TABSTOP,
12,26,42,126, hWindow, 0, Inst, nil);
getDrive;
htitle:=Createwindow('STATIC',
'序列号:',
WS_VISIBLE or WS_CHILD or SS_LEFT,
62,10,50,15, hWindow, 0, Inst, nil);
SendMessage(htitle,WM_SETFONT,hFont1,0);
 
hID:= CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
'1979-1126',
WS_CHILD or WS_VISIBLE or WS_TABSTOP or ES_AUTOHSCROLL or WS_EX_STATICEDGE or WS_BORDER,
60,26,95,23, hWindow, 0, Inst, nil);
SendMessage(hID,EM_LIMITTEXT,LParam(9),WParam(9));
initSerial;
cmbChange := CreateWindow( 'BUTTON','改变',WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP or BS_FLAT,
5,85,50,22, hWindow, 0, Inst, nil);
cmbAbout:= CreateWindow( 'BUTTON','关于',WS_EX_STATICEDGE or WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP or BS_FLAT ,
60,85,50,22, hWindow, 0, Inst, nil);
cmbExit:= CreateWindow( 'BUTTON','退出',WS_VISIBLE or WS_CHILD
or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP or BS_Flat,
115,85,50,22, hWindow, 0, Inst, nil);
isNT:=false;
if GetVersion shr 31=0 then isNT:=true;
SendMessage(cmbChange,WM_SETFONT,hFont1,0);
SendMessage(cmbAbout,WM_SETFONT,hFont1,0);
SendMessage(cmbExit,WM_SETFONT,hFont1,0);
 
while GetMessage(TheMessage,0,0,0) do begin
if not IsDialogMessage(hWindow,TheMessage) then begin
TranslateMessage(TheMessage);
DispatchMessage(TheMessage);
end;
end;
end.