unit Unit1;
{=====================================
软件保护思路 ：
  KeyFile验证而且是利用图片加密比较
                              by:VxinLv
           HomePage:www.3WorkRoom.cn
=====================================}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Registry, WinSkinData, StdCtrls,  ExtCtrls, Mask;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    SkinData1: TSkinData;
    Image2: TImage;
    Edit_Name: TEdit;
    Label1: TLabel;
    Edit_Code: TEdit;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function GetIdeSerialNumber: pchar;  //=============获取硬盘的出厂系列号
  const IDENTIFY_BUFFER_SIZE = 512;
type
   TIDERegs = packed record
     bFeaturesReg: BYTE;
     bSectorCountReg: BYTE;
     bSectorNumberReg: BYTE;
     bCylLowReg: BYTE;
     bCylHighReg: BYTE;
     bDriveHeadReg: BYTE;
     bCommandReg: BYTE;
     bReserved: BYTE;
  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;
  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;
  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 := '';
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000
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;
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 ASCII10ADD(s: string): Integer;  //=============取10进制累加值
var i,sum:integer;
begin
   sum:=0;  for i:=1 to length(s) do
begin
   sum:=sum+ord(s[i]);
end;
   Result :=sum;
end;

function myHextoStr(S: string): string;   //=============16进制字符串转原字符串
var hexS,tmpstr:string;
    i:integer;
    a:byte;
begin
    hexS  :=s;//应该是该字符串
    if length(hexS) mod 2=1 then
    begin
        hexS:=hexS+'0';
    end;
    tmpstr:='';
    for i:=1 to (length(hexS) div 2) do
    begin
        a:=strtoint('$'+hexS[2*i-1]+hexS[2*i]);
        tmpstr := tmpstr+chr(a);
    end;
    result :=tmpstr;
end;

procedure EncryptBMP(const BMP: TBitmap; Key: Integer);  //=============加密图片
var
  BytesPorScan: Integer;
  w, h: integer;
  p: pByteArray;
begin
  try
    BytesPorScan := Abs(Integer(BMP.ScanLine[1]) -
      Integer(BMP.ScanLine[0]));
  except
    raise Exception.Create('Error');
  end;
  RandSeed := Key;
  for h := 0 to BMP.Height - 1 do
  begin
    P := BMP.ScanLine[h];
    for w := 0 to BytesPorScan - 1 do
      P^[w] := P^[w] xor Random(256);
  end;
end;

function IsHomology(bmp1, bmp2: TbitMap): boolean;   //=============图片验证
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;
var
  x, y: integer;
  p0, p1: PRGBTripleArray;
  sBmp, dBmp: TBitMap;
begin
  Result := False;

  if (bmp1.Height <> bmp2.Height) or
    (bmp1.Width <> bmp2.Width) then
  begin
    Exit;
  end;

  sBmp := TBitmap.Create;
  dBmp := TBitmap.Create;
  try
    sBmp.Assign(bmp1);
    dBmp.Assign(bmp2);
    sBmp.PixelFormat := pf24bit;
    dBmp.PixelFormat := pf24bit;
    for y := 0 to sBmp.Height - 1 do
    begin
      p0 := sBmp.ScanLine[y];
      p1 := dBmp.ScanLine[y];
      for x := 0 to sBmp.Width - 1 do
        if (p0[x].rgbtBlue = p1[x].rgbtBlue) and
          (p0[x].rgbtGreen = p1[x].rgbtGreen) and
          (p0[x].rgbtRed = p1[x].rgbtRed) then
        begin
          Result := True;
        end
        else
        begin
          Break;
        end;
    end;
  finally
    sBmp.Free;
    dBmp.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     try
      if (Length(Edit_Name.Text)>2) and (FileExists('3w.bmp')) //=========忽悠一下Cracker
          and (myHextoStr(Edit_Code.Text)=Edit_Name.Text)  then //====重点就是验证图片
      begin
       Image2.Picture.LoadFromFile('3w.bmp'); //=========载入图片
       EncryptBMP(Image2.Picture.Bitmap, ASCII10ADD(Trim(strpas(GetIdeSerialNumber)))); //===恢复加密过的图片
       Image2.Refresh;
       if IsHomology(Image1.Picture.Bitmap,Image2.Picture.Bitmap) then  //============验证图片
         begin
           Application.MessageBox(PChar('注册成功！正式授权给：'+Edit_name.text),'提示',MB_OK+64);
         end;
         end
     else
      Application.MessageBox(PChar('非法用户！请与软件开发商联系。'),'错误',MB_OK+64);
       except
     end;
end;
       
procedure TForm1.FormShow(Sender: TObject);
begin
     Edit_Name.SetFocus;
end;

end.

[培训]《安卓高级研修班(网课)》月薪三万计划，掌握调试、分析还原ollvm、vmp的方法，定制art虚拟机自动化脱壳的方法