تسجيل البرنامج من خلال سريال الهارد

PHP كود :
==========================================
unit MainUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, registry, ExtCtrls, XPMan, ShellAPI;

type

 TForm1 = class(TForm)
   Panel1: TPanel;
   edPassword: TEdit;
   edCode: TEdit;
   btnOK: TButton;
   Label2: TLabel;
   Label3: TLabel;
   procedure FormCreate(Sender: TObject);
   procedure btnOKClick(Sender: TObject);
   procedure edCodeDblClick(Sender: TObject);
   procedure edPasswordDblClick(Sender: TObject);
 private
   { Déclarations privées }
 public
   { Déclarations publiques }
 end;

var
 Form1: TForm1;
 reg: Tregistry;
 
implementation

{$R *.dfm}

function GetIdeSerialNumber0 ():string;
const IDENTIFY_BUFFER_SIZE = 512;
type
 TIDERegs = packed record
   bFeaturesReg     : BYTE; // Used for specifying SMART "commands".
   bSectorCountReg  : BYTE; // IDE sector count register
   bSectorNumberReg : BYTE; // IDE sector number register
   bCylLowReg       : BYTE; // IDE low order cylinder value
   bCylHighReg      : BYTE; // IDE high order cylinder value
   bDriveHeadReg    : BYTE; // IDE drive/head register
   bCommandReg      : BYTE; // Actual IDE command.
   bReserved        : BYTE; // reserved for future use.  Must be zero.
 end;
 TSendCmdInParams = packed record
   cBufferSize  : DWORD;
   irDriveRegs  : TIDERegs;
   bDriveNumber : BYTE;
   bReserved    : Array[0..2] of Byte;
   dwReserved   : Array[0..3] of DWORD; 
   bBuffer      : Array[0..0] of Byte;  // Input buffer.
 end; 
 TIdSector = packed record
   wGenConfig                 : Word; 
   wNumCyls                   : Word;
   wReserved                  : Word; 
   wNumHeads                  : Word;
   wBytesPerTrack             : Word; 
   wBytesPerSector            : Word;
   wSectorsPerTrack           : Word;
   wVendorUnique              : Array[0..2] of Word;
   sSerialNumber              : Array[0..19] of CHAR; 
   wBufferType                : Word;
   wBufferSize                : Word; 
   wECCSize                   : Word;
   sFirmwareRev               : Array[0..7] of Char;
   sModelNumber               : Array[0..39] of Char;
   wMoreVendorUnique          : Word;
   wDoubleWordIO              : Word;
   wCapabilities              : Word;
   wReserved1                 : Word;
   wPIOTiming                 : Word;
   wDMATiming                 : Word;
   wBS                        : Word; 
   wNumCurrentCyls            : Word;
   wNumCurrentHeads           : Word; 
   wNumCurrentSectorsPerTrack : Word;
   ulCurrentSectorCapacity    : DWORD;
   wMultSectorStuff           : Word;
   ulTotalAddressableSectors  : DWORD; 
   wSingleWordDMA             : Word;
   wMultiWordDMA              : Word; 
   bReserved                  : Array[0..127] of BYTE;
 end;
 PIdSector = ^TIdSector;
 TDriverStatus = packed record
   bDriverError : Byte;
   bIDEStatus   : Byte;
   bReserved    : Array[0..1] of Byte;
   dwReserved   : Array[0..1] of DWORD;
 end;
 TSendCmdOutParams = packed record
   cBufferSize  : DWORD;
   DriverStatus : TDriverStatus;
   bBuffer      : Array[0..0] of BYTE;
 end;
 var
   hDevice : THandle;
   cbBytesReturned : DWORD;
//    ptr : PChar;
   SCIP : TSendCmdInParams;
   aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
   IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;

procedure ChangeByteOrder(var Data; Size : Integer );
var
 ptr : PChar;
 i : Integer;
 c : Char;
begin
   ptr := @Data;
   for i := 0 to (Size shr 1)-1 do
   begin
     c := ptr^;
     ptr^ := (ptr+1)^;
     (ptr+1)^ := c;
     Inc(ptr,2);
   end;
 end;
begin
 Result := ''; // return empty string on error
 if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000

begin
//íãßä ÊÛíÑ PhysicalDrive0 Çáì PhysicalDrive1 Çæ PhysicalDrive2
  hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
 FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
 end
 else // Version Windows 95 OSR2, Windows 98
 hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
 if hDevice=INVALID_HANDLE_VALUE then Exit;
 try
   FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
   FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
   cbBytesReturned := 0;
   with SCIP do
   begin
   cBufferSize  := IDENTIFY_BUFFER_SIZE;
   bDriveNumber := 0;
  with irDriveRegs do
  begin
    bSectorCountReg  := 1;
    bSectorNumberReg := 1;
    bDriveHeadReg    := $A0;
    bCommandReg      := $EC;
   end;
   end;
   if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
     @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
 finally
   CloseHandle(hDevice);
 end;
 with PIdSector(@IdOutCmd.bBuffer)^ do
 begin
   ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
   (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
   Result := PChar(@sSerialNumber);
 end;
end;

function get_password(a: string): string;
var
 b: string;
 c: char;
 i,n: integer;
begin
 b:='';
 for i := 1 to length(a) do
 begin
   c:= a[i];
   n:= ord(c);
   n:=n+(2*i);
   b:=b+chr(n);
 end;
 Result:=b;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 edPassword.Text:=Trim(GetIdeSerialNumber0);
end;

procedure JumpToKey(Key: string);
var
 i, n: Integer;
 hWin: HWND;
 ExecInfo: ShellExecuteInfoA;
begin
 hWin := FindWindowA(PChar('RegEdit_RegEdit'), nil);
 if hWin = 0 then
 {if Regedit doesn't run then we launch it}
 begin
   FillChar(ExecInfo, 60, #0);
   with ExecInfo do
   begin
     cbSize := 60;
     fMask  := SEE_MASK_NOCLOSEPROCESS;
     lpVerb := PChar('open');
     lpFile := PChar('regedit.exe');
     nShow  := 1;
   end;
   ShellExecuteExA(@ExecInfo);
   WaitForInputIdle(ExecInfo.hProcess, 200);
   hWin := FindWindowA(PChar('RegEdit_RegEdit'), nil);
 end;
 ShowWindow(hWin, SW_SHOWNORMAL);
 hWin := FindWindowExA(hWin, 0, PChar('SysTreeView32'), nil);
 SetForegroundWindow(hWin);
 i := 30;
 repeat
   SendMessageA(hWin, WM_KEYDOWN, VK_LEFT, 0);
   Dec(i);
 until i = 0;
 Sleep(500);
 SendMessageA(hWin, WM_KEYDOWN, VK_RIGHT, 0);
 Sleep(500);
 i := 1;
 n := Length(Key);
 repeat
   if Key[i] = '\' then
   begin
     SendMessageA(hWin, WM_KEYDOWN, VK_RIGHT, 0);
     Sleep(500);
   end
   else
     SendMessageA(hWin, WM_CHAR, Integer(Key[i]), 0);
   i := i + 1;
 until i = n;
end;

procedure TForm1.btnOKClick(Sender: TObject);
var
 reg: TRegistry;
begin
 if edCode.Text = get_password(Trim(edPassword.Text)) then
 begin
   reg:=TRegistry.Create;
   reg.RootKey:=HKEY_CURRENT_USER;
   reg.OpenKey('Software\osamadiab',true);
   reg.WriteString('osama',edCode.Text);
   if MessageBox(Handle, 'Êã ÊÓÌíá ãÝÊÇÍ ÇáÑÌÓÊÑí ÈäÍÇÍ¡ åá ÊÑÛÈ ÈãÔÇåÏÊå ¿','ÊäÈíå',MB_YESNO) = IDYES then
   JumpToKey('HKEY_CURRENT_USER\Software\osamadiab');
 end else MessageBox(Handle, 'ÇáÑÞã ÇáÊÓáÓáí ÎÇØÆ','Error',MB_ICONERROR);
end;

procedure TForm1.edCodeDblClick(Sender: TObject);
begin
 with (Sender as TEdit) do begin
     SelectAll;
     PasteFromClipboard;
   end;
end;

procedure TForm1.edPasswordDblClick(Sender: TObject);
begin
 with (Sender as TEdit) do begin
     SelectAll;
     CopyToClipboard;
   end;
end;

end.