type
TCPUID = array[1..4] of Longint;
TVendor = array [0..11] of char;
function GetCPUID1 : TCPUID; assembler; register;
asm
PUSH EBX {Save affected register}
PUSH EDI
MOV EDI,EAX {@Resukt}
MOV EAX,1
DW $A20F {CPUID Command}
STOSD {CPUID[1]}
MOV EAX,EBX
STOSD {CPUID[2]}
MOV EAX,ECX
STOSD {CPUID[3]}
MOV EAX,EDX
STOSD {CPUID[4]}
POP EDI {Restore registers}
POP EBX
end;
function GetCPUID3 : TCPUID; assembler; register;
asm
PUSH EBX {Save affected register}
PUSH EDI
MOV EDI,EAX {@Resukt}
MOV EAX,3
DW $A20F {CPUID Command}
STOSD {CPUID[1]}
MOV EAX,EBX
STOSD {CPUID[2]}
MOV EAX,ECX
STOSD {CPUID[3]}
MOV EAX,EDX
STOSD {CPUID[4]}
POP EDI {Restore registers}
POP EBX
end;
function GetIdeDiskSerialNumber : String;
type
TSrbIoControl = packed record
HeaderLength : ULONG;
Signature : Array[0..7] of Char;
Timeout : ULONG;
ControlCode : ULONG;
ReturnCode : ULONG;
Length : ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;
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. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;
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;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;
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 : ULONG;
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;
const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IOCTL_SCSI_MINIPORT = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer; // PSendCmdOutParams
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;
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 := '';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
// Get SCSI port handle
hDevice := CreateFile( '\\.\Scsi0:',GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then
Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer)+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
@Buffer, BufferSize, @Buffer, BufferSize,
cbBytesReturned, nil ) then
Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin // Windows 95 OSR2, Windows 98
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil,Create_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then
Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := @pInData^.bBuffer;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
pInData, SizeOf(TSendCmdInParams)-1, pOutData,
W9xBufferSize, cbBytesReturned, nil ) then
Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Close;
end;
{用序列号的前45位验证后5位}
{我也是没办法翻译才写成这样的，哎！}
function CalcLast5Bit(code:string):string;
var
k,eax,ecx,dl,edi,i,len:integer;
esi,str:string;
Label
label0043E2B0,label0043E278,label0043E28A,label0043E298,
label0043E29A,label0043E2A3,label0043E287;
begin
len:=length(code);
if len<50 then
len:=50;
k:=1;
esi:=code;
eax:=0;
ecx:=0;
label0043E278:
if ecx<>$0b26d then
goto label0043E2B0;
edi:=0;
if edi>=len-5 then
goto label0043E2B0;
label0043E287:
inc(ecx);
dl:=$80;
label0043E28A:
if (eax and $00008000)=0 then
goto label0043E298;
eax:=eax*2;
eax:=eax xor $00001021;
inc(ecx);
goto label0043E29A;
label0043E298:
eax:=eax*2;
label0043E29A:
inc(ecx);
if (ord(esi[k])and dl)=0 then
goto label0043E2A3;
eax:=eax xor $00001021;
label0043E2A3:
dl:=dl div 2;
if dl<>0 then
goto label0043E28A;
inc(k);
inc(edi);
if edi<len-5 then
goto label0043E287;
label0043E2B0:
inc(ecx);
if ecx<$186a0 then
goto label0043E278;
str:='';
esi:=inttostr(eax and $0000ffff);
for i:=length(esi)+1 to 5 do
str:=str+'0';
str:=str+esi;
result:=str;
end;
{试验码的换位和20位验证码的生成}
{只处理前40位}
function CalcStr20(code:string):string;
var
temp:char;
k,j,eax,edx:integer;
begin
k:=0;
j:=1;
temp:=code[3];
code[3]:=code[39];
code[39]:=temp;
temp:=code[5];
code[5]:=code[26];
code[26]:=temp;
temp:=code[10];
code[10]:=code[32];
code[32]:=temp;
while k<40 do
begin
inc(k);
edx:=k div 2;
eax:=strtoint(code[k]+code[k+1]);
eax:=eax+edx;
inc(k);
eax:=eax+9;
code[j]:=chr(eax and $000000ff);
inc(j);
end;
code[j]:=#0;
result:=code;
end;
{用注册名和机器码，计算5位验证码}
function CalcUseName(name,code:string):string;
var
al,i,edi:integer;
str:string;
begin
setlength(str,21);
edi:=0;
i:=0;
while i<20 do
begin
if i<length(name)then
al:=ord(name[i+1])
else
al:=0;
al:=al xor ord(code[i+1]);
str[i+1]:=chr(al);
edi:=i*al+edi;
inc(i);
end;
result:=inttostr(edi+$3039);
end;
{取得机器码}
function GetMachineCode:string;
var
CPUID1,CPUID3:TCPUID;
str:string;
i,c1,c2,c3,c4:integer;
begin
str:=GetIdeDiskSerialNumber;
for i:=1 to 20 do
begin
str:=chr((ord(str)mod 10)+48);
end;
CPUID1 := GetCPUID1;
CPUID3 := GetCPUID3;
CPUID1[4]:=CPUID1[4]xor CPUID1[3];
CPUID1[4]:=CPUID1[4]xor CPUID1[1];
CPUID1[4]:=CPUID1[4]xor CPUID3[4];
CPUID1[4]:=CPUID1[4]xor CPUID3[3];
CPUID1[4]:=CPUID1[4]xor CPUID3[2];
c1:=CPUID1[4]shr 24;
c2:=(CPUID1[4]shr 16)and$00ff;
c3:=(CPUID1[4]shr 8) and $0000ff;
c4:=CPUID1[4]and $000000ff;
str[5]:=chr((ord(str[5]) xor c1)mod 10 +48);
str[4]:=chr((ord(str[4]) xor c2)mod 10 +48);
str[3]:=chr((ord(str[3]) xor c3)mod 10 +48);
str[2]:=chr((ord(str[2]) xor c4)mod 10 +48);
result:=str;
end;
{计算注册码}
function CalcCode(key:string):string;
var
str,s:string;
i,num,eax,edi:integer;
begin
str:='xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx';
str[1]:=inttostr(ord(key[1])+20-9)[1];
str[2]:=inttostr(ord(key[1])+20-9)[2];
str[39]:=inttostr(ord(key[2])+20-9-1)[1];
str[4]:=inttostr(ord(key[2])+20-9-1)[2];
str[26]:=inttostr(ord(key[3])+20-9-2)[1];
str[6]:=inttostr(ord(key[3])+20-9-2)[2];
str[7]:=inttostr(ord(key[4])+20-9-3)[1];
str[8]:=inttostr(ord(key[4])+20-9-3)[2];
str[9]:=inttostr(ord(key[5])+20-9-4)[1];
str[32]:=inttostr(ord(key[5])+20-9-4)[2];
for i:=1 to 45 do
if str='x' then
str:=chr(random(10)+48);
edi:=strtoint(key)+$4D44;
eax:=round(edi*3.14*0.1594896331738437110-0.5);
edi:=eax mod 100000;
eax:=edi MOD 10;
eax:=eax+$41-14;
s:=inttostr(eax);
str[11]:=s[1];
str[12]:=s[2];
s:=CalcStr20(str);
num:=0;
for i:=1 to 19 do
num:=num+ord(s);
s:=inttostr((num mod 10)+20);
str[3]:=s[1];
str[40]:=s[2];
str:=str+CalcLast5Bit(str);
result:=str;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
key,code,name:string;
i:integer;
begin
name:=edit1.text;
for i:=1 to length(name) do
if ord(name)>127 then
begin
Application.MessageBox('别欺负我,我不知道中文名字怎么算!','提示',MB_ICONINFORMATION+MB_OK);
edit1.Text:='';
Exit;
end;
if (length(name)<1)or(length(name)>19) then
begin
Application.MessageBox('注册名长度为1-19位','提示',MB_ICONINFORMATION+MB_OK);
Exit;
end;
key:=GetMachineCode;
key:=CalcUseName(name,key);
code:=CalcCode(key);
edit2.text:=code;
end;
这是 高人 写的 我想做成注册机 看那些不让看的教程和视频 谁帮下忙啊
[课程]FART 脱壳王！加量不加价！FART作者讲授！
