Delphi通过机器码获得注册码的完整方案

通过机器码获得注册码的完整方案（转贴过来,留着看看）

想加密自己的软件，看过一些软件的作法，思路如下：
1、用户安装后，得出本机的机器码（硬盘的序列号，不想用网卡，因为很多机器没有网
卡）。生成机器码代码
2、用户将该机器码EMAIL给我，我用该机器码生成一个注册码，发送给用户。注册码生成
代码
3、用户在程序中输入该注册码，程序逆算该注册码，与机器码核对，查看是否相符。注册
码逆算、核对代码，
4、如果用户安装后没有得到注册码，在N天后部分功能不可用。不要太容易被改（虽然说
安装后也只有少部份功能能用）。时限功能代码，

zw84611 (2002-12-2 23:8)
function GetHDNumber(Drv : String): DWORD; //得到硬盘序列号
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
begin
if Drv[Length(Drv)] =':' then Drv := Drv + '\';
GetVolumeInformation(pChar(Drv),
nil,
0,
@VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
Result:= (VolumeSerialNumber);
end;

function Serial(Num:DWORD):string; //这个号码是用户给你生成注册码的，它通过对硬盘序列号编码而来。
var sNum:string; inChar:array[1..4]of char;
begin

Num:=Num xor 8009211011;
sNum:=inttostr(Num);
inChar[1]:=char(((integer(sNum[1])+integer(sNum[2]))mod 5)+integer('a'));
inChar[2]:=char(((integer(sNum[3])+integer(sNum[4]))mod 5)+integer('a'));
inChar[3]:=char(((integer(sNum[5])+integer(sNum[6]))mod 5)+integer('a'));
inChar[4]:=char(((integer(sNum[7])+integer(sNum[8])+integer(sNum[9]))mod 5)+integer('a'));
insert(inChar[1],sNum,1);
insert(inChar[4],sNum,3);
insert(inChar[2],sNum,5);
insert(inChar[3],sNum,9);
Result:=sNum;

end;

function encode(License:string):string;
var str,sNum:string; number:dword; byte,byte1:array[1..4]of dword;
inChar:array[1..3]of char;
begin
str:=license;
delete(str,1,1);
delete(str,2,1);
delete(str,3,1);
delete(str,6,1);
number:=strtoint64(str);
number:=not number;
number:=number xor $1973122980;
byte[1]:=(number and $0ff000000) shr 24;
byte[2]:=(number and $0ff0000) shr 16;
byte[3]:=(number and $0ff00) shr 8;
byte[4]:=(number and $0ff);

byte1[1]:=((byte[1]and $0c0)+(byte[2]and $0c0)shr 2)+((byte[3]and $0c0)shr 4)+((byte[4]and $0c0)shr 6);
byte1[2]:=((byte[1]and $30)shl 2)+(byte[2]and $30)+((byte[3]and $30)shr 2)+((byte[4]and $30)shr 4);
byte1[3]:=((byte[1]and $0c)shl 4)+((byte[2]and $0c)shl 2)+(byte[3]and $0c)+((byte[4]and $0c)shr 2);
byte1[4]:=((byte[1]and $03)shl 6)+((byte[2]and $03)shl 4)+((byte[3]and $03)shl 2)+(byte[4]and $03);
number:=((byte1[1])shl 24)+((byte1[2])shl 16)
+((byte1[3])shl 8)+(byte1[4]);

byte[1]:=((number and $0ff000000)shr 24);//右移24位
byte[2]:=((number and $0ff0000)shr 16);
byte[3]:=((number and $0ff00)shr 8);
byte[4]:=(number and $0ff);

byte[1]:=(((byte[1] and $f0))shr 4)+(((byte[1] and $0f))shl 4);
byte[2]:=(((byte[2] and $f0))shr 4)+(((byte[2] and $0f))shl 4);
byte[3]:=(((byte[3] and $f0))shr 4)+(((byte[3] and $0f))shl 4);
byte[4]:=(((byte[4] and $f0))shr 4)+(((byte[4] and $0f))shl 4);

number:=((byte[2])shl 24)+((byte[1])shl 16)
+((byte[4])shl 8)+(byte[3]);

sNum:=inttostr(Number);
inChar[1]:=char(((integer(sNum[1])+integer(sNum[2]))mod 5)+integer('a'));
inChar[2]:=char(((integer(sNum[3])+integer(sNum[4]))mod 5)+integer('a'));
inChar[3]:=char(((integer(sNum[5])+integer(sNum[6]))mod 5)+integer('a'));
insert(inChar[1],sNum,1);
insert(inChar[2],sNum,5);
insert(inChar[3],sNum,9);
result:=sNum;

end;

function decode(code:string):dword;
var str:string; number:dword; byte,byte1:array[1..4]of dword;
begin

str:=code;
delete(str,1,1);
delete(str,4,1);
delete(str,7,1);
number:= strtoint64(str);
byte[1]:=(number and $0ff000000) shr 24;
byte[2]:=(number and $0ff0000) shr 16;
byte[3]:=(number and $0ff00) shr 8;
byte[4]:=(number and $0ff);

////0123 --> 1032
byte[1]:=(((byte[1] and $f0))shr 4)+(((byte[1] and $0f))shl 4);
byte[2]:=(((byte[2] and $f0))shr 4)+(((byte[2] and $0f))shl 4);
byte[3]:=(((byte[3] and $f0))shr 4)+(((byte[3] and $0f))shl 4);
byte[4]:=(((byte[4] and $f0))shr 4)+(((byte[4] and $0f))shl 4);

number:=((byte[2])shl 24)+((byte[1])shl 16)
+((byte[4])shl 8)+(byte[3]);

byte[1]:=((number and $0ff000000)shr 24);//右移24位
byte[2]:=((number and $0ff0000)shr 16);
byte[3]:=((number and $0ff00)shr 8);
byte[4]:=(number and $0ff);

byte1[1]:=(byte[1]and $0c0)+((byte[2]and $0c0)shr 2)+((byte[3]and $0c
oceanwave (2002-12-3 7:28)
谢先！试试看，可以后马上开贴给分。
妙兔无花 (2002-12-3 7:41)
分
sxd781017 (2002-12-3 7:50)
good!
oceanwave (2002-12-3 8:1)
to zw84611:
试了你的代码后，有几个问题请教：
1、用GetHDNumber取得硬盘序列号后，用Serial生成注册码。那encode和decode如何用呢？
2、如何将serial逆算成为硬盘序列号与原序列号相核对？
3、Serial函数中第一行的8009211011应该就是一个加密转换的常量吧？还有inChar的Index
值？

oceanwave (2002-12-3 8:35)
看了一篇这方面的文章，是VC++的，不过思路一样
http://www.powerba.com/develop/vc/article/20011113001.htm

youth[dfw] (2002-12-3 8:37)
1、利用RSA算法
2、在功能函数中进行校验
3、多处进行校验
4、利用线程、消息、延时
5、监测软件关键点，防止强行跳过
、、、
飘摇客 (2002-12-4 9:25)
可行，使用GUID，放在注册表中，同时把这个GUID发回给你，你可以使用这个进行注册码和注册码验证。
获得GUID，
uses activex;

var
guid:TGUID;

CoCreateGUID(guid);
ShowMessage(GuidToString(guid));

yczjs (2002-12-4 10:19)
用SoftSentry加密软件搞定
Delphi园地
http://mydelphi.8u8.com

飘摇客 (2002-12-4 13:40)
其实任何的加密基本上都能被破解，这里给你一个思路。
1、用户第一次运行软件后，生成一个GUID，保存在注册表中，另外存储在文件中或者写入系统已有的文件尾部。
此为机器码，让用户发回，如果用户在注册表中删除了，就从文件中读取GUID，然后写入注册表。当然
应该还需用户发回用户的相关信息，保证在重新安装机器时能向你索回注册码;
2、根据此GUID写一个验证序列号的过程（软件中）;
3、写一个注册机，根据用户邮寄回的GUID得到注册码，发给用户用于注册;
4、最好提供在线更新功能，更新时记录用户机器码（GUID），如发现有同一个GUID对同一个版本进行更新，就发布新的版本，使该GUID对应的注册码不可用。
zbsfg (2002-12-4 13:52)
oceanwave (2002-12-4 14:16)
前面我有给过一个网址：
http://www.powerba.com/develop/vc/article/20011113001.htm
这里就有提到：
------------------------------------------------------------------------------
为了确保注册码的唯一性，在注册源的采集上应当尽量选取一些唯一的、不易复制的软、
硬件信息作为原始信息。而硬件由于其不可复制性和物理唯一性成为了我们的首选目标，
而且多数计算机配件在出厂时都有一个唯一的标识号，我们可以将其作为识别的依据。符
合上述条件的标识号大致有硬盘的序列号、网卡的序列号、BIOS中的主版序列号或主机出
厂日期和标志等几种，考虑到硬件通用性、实现起来的难易程度以及系统安全性等多种因
素以硬盘序列号为佳，因为网卡随说唯一性最好但不能保证每台计算机都装有网卡，而
ROM BIOS中F000H-FFFFH区域虽存有与硬件配置有关的信息、F000H:FFF5H-F000H:FFFFH存
有主机出厂日期和主机标志值等参数，但在Windows 9x的保护模式下编程实现是比较困难
的。虽然在Windows 9x保护模式下对硬盘序列号也不能按通常在DOS模式下的通过硬盘端口
1F6H和1F7H直接读取，但Windows API函数中提供的下面这个函数可以非常简单的获取到指
定磁盘驱动器的序列号：
GetVolumeInformation("C:\\",NULL,NULL,&dwIDESerial,NULL,NULL,NULL,NULL);
第一个参数设为"C:\\"表示我们要读取C盘驱动器的序列号。之所以选C盘，是因为我们不
能保证用户有多个分区，而C盘却是每一个用户都具有的。该函数成功调用完毕后，在
DWORD型的变量dwIDESerial中就存储了获取到的32位长的磁盘序列号。注册信息采集到后
，关键的问题就是如何让用户将其返回给开发者。一种较简单的方法是把采集到的硬盘序
列号与用户输入的注册名经过位操作的简单加密后存放到一个文本中通过邮件传送给开发
者。
------------------------------------------------------------------------------
oceanwave (2002-12-5 11:20)
软件加密系列问题2：加密算法
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1487410
软件加密系列问题3：注册信息的保存
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1487438

oceanwave (2002-12-5 11:23)
软件加密系列问题0：注册流程
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1487449
zbsfg (2002-12-6 9:23)
crc32算法，保证能用
UNIT CRC32;

INTERFACE

USES
Windows; // DWORD for D3/D4 compatibility

TYPE
{$IFDEF VER130} // This is a bit awkward
// 8-byte integer
TInteger8 = Int64; // Delphi 5
{$ELSE}
{$IFDEF VER120}
TInteger8 = Int64; // Delphi 4
{$ELSE}
TInteger8 = COMP; // Delphi 2 or 3
{$ENDIF}
{$ENDIF}

PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCvalue: DWORD);

PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;
VAR TotalBytes: TInteger8;
VAR error: WORD);

IMPLEMENTATION

USES
{$IFDEF StreamIO}
SysUtils, // SysErrorMessage
{$ENDIF}
Dialogs, // ShowMessage
Classes; // TMemoryStream

CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,

$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,

$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,

$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);

// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same"
建议注册码采用CpuID+HD_SER+MAC，只有这些东东是不会
常改变的，这样可以减少作者的一些工作，否则常给别人换注册码很累，最好还能做
到网上较验，否则一个用户多个注册码的话也是挺棘手的事。

tohappy (2003-4-27 8:14)
关注下列问题，一定对你有益：
http://delphibbs.com/delphibbs/dispq.asp?lid=1743719
http://delphibbs.com/delphibbs/dispq.asp?lid=1742072
http://delphibbs.com/delphibbs/dispq.asp?lid=1655569
http://delphibbs.com/delphibbs/dispq.asp?lid=1786356
3cs (2003-4-27 15:29)
得到硬盘物理号及简单的算法：我贴出，我都是用它，挺好的，哈哈！
unit ISDNUNIT;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

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;
bSectorCountReg: Byte;
bSectorNumberReg: byte;
bCyllowReg: byte;
bCylhighreg:byte;
bDriveHeadReg: byte;
bCommandReg: byte;
bReserved: byte;
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..10] 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;
wreservedL: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;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

end;
// procedure ChangeByteorder(var data; Size:INTEGER);
// Function readhdserial:string;
// FUNCTION ENCRyPT(serial:string):string;
var
Form1: TForm1;
serial:string;
inputserial:string;
CONST
IDENTIFY_BUFFER_SIZE=512;
DataSize=sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
IOCTL_SCSI_MINIPORT=$0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY=$001b0501;
IDE_ID_FUNCTION=$EC;
BufferSize=1280;
implementation

{$R *.DFM}

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;

function readhdserial:string;
var
hDevice:THandle;
cbBYTESReturned:DWORD;
pindata:PSendCmdInParams;
//pide:Pideregs;
pOutData:Pointer;
Buffer:Array[0..BufferSize-1] of Byte;
srbCONTROL:tSrbIoControl absolute Buffer;
begin
result:='';
Fillchar(Buffer,buffersize,#0);
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;
// irDriveRegs:=0;
with irDriveRegs do
begin
bFeaturesreg:=1;
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;
with Pidsector(pchar(poutdata)+16)^ do
begin
changebyteorder(sSerialNUMber,sizeof(sserialnumber));
setstring(result,sserialnumber,sizeof(......