软件注册的实现 delphi 源码
原理:通过获取本机的硬盘CPU的序列号,合成为一个40位的机器码,然后再进行MD5编码得到机器码:
下面是main.pas的代码:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
procedure Edit1DblClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Amd5;
{$R *.dfm}
//=========
type
TCPUID = array[1..4] of Longint;
TVendor = array [0..11] of char;
function GetCPUID : 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 GetCPUVendor : TVendor; assembler; register;
asm
PUSH EBX {Save affected register}
PUSH EDI
MOV EDI,EAX {@Result (TVendor)}
MOV EAX,0
DW $A20F {CPUID Command}
MOV EAX,EBX
XCHG EBX,ECX {save ECX result}
MOV ECX,4
@1:
STOSB
SHR EAX,8
LOOP @1
MOV EAX,EDX
MOV ECX,4
@2:
STOSB
SHR EAX,8
LOOP @2
MOV EAX,EBX
MOV ECX,4
@3:
STOSB
SHR EAX,8
LOOP @3
POP EDI {Restore registers}
POP EBX
end;
//获得硬盘序列号
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; // 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;
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
hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
end else
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 GetCode():string;//提取机器码。
var
CPUID:TCPUID;
i:Integer;
s1,s2,s3,s4,s5:string;
RegCode:string;
begin
for i:=Low(CPUID) to High(CPUID) do CPUID[i]:=-1;
CPUID:=GetCPUID;
s1:=IntToHex(CPUID[1],8);
s2:=IntToHex(CPUID[2],8);
s3:=IntToHex(CPUID[3],8);
s4:=IntToHex(CPUID[4],8);
s5:=trim(strpas(GetIdeSerialNumber));
RegCode:=copy(s2,1,4)+copy(s5,5,4)+copy(s3,1,4)+copy(s1,1,4)+copy(s4,5,4)+copy(s5,1,4)+copy(s4,1,4)+copy(s1,5,4)+copy(s3,5,4)+copy(s2,5,4);
GetCode:=RegCode;
end;
procedure TForm1.Edit1DblClick(Sender: TObject);
begin
Edit1.Text:=GetCode();
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if Length(Edit1.Text)<>40 then
begin
ShowMessage('机器码应该是一个长度为40的字符串!');
Abort;
end;
edit2.Text:=AMD5.sMD5.MD5(edit1.Text);
end;
end.
下面是md5.pas的代码:
unit AMD5;
interface
// 文件名 : AMD5.pas //
// 功能 : 与md5.asp计算结果相同 //
// 作者 : 由ScriptBaby改编自md5.asp //
// 完成时间: 2004-07-21 //
//请转载者保留以上信息,谢谢//
uses
SysUtils;
type
arrlongword = array of longword;
type
sMD5 = class
class function RotateLeft(const lValue, Bits: longword): longword;
class function MD5(const sMessage: string; const sType: boolean = false): string;
class function ConvToWord(const sMessage: string): arrlongword; overload;
class function ConvToWord(const sMessage: WideString): arrlongword; overload;
class function WordToHex(const lValue: longword): string;
end;
implementation
const
BITS_TO_A_BYTE = 8;
BYTES_TO_A_WORD = 4;
BITS_TO_A_WORD = 32;
cAA = $67452301;
cBB = $EFCDAB89;
cCC = $98BADCFE;
cDD = $10325476;
MODULUS_BITS = 512;
CONGRUENT_BITS = 448;
{ sMD5 }
class function sMD5.ConvToWord(const sMessage: WideString): arrlongword;
var
lMessageLength,
lNumberOfWords,
lBytePosition,
lByteCount,
lWordCount: longword;
lWordArray: arrlongword;
{ Function }
function Asc(const t: WideChar): Smallint;
var
s: string;
a: Smallint;
begin
s := t;
a := Smallint(s[1]);
case Length(s) of
2:
begin
a := a shl 8;
a := a + Smallint(s[2]);
end
else ;
end;
Result := a;
end;
begin
lMessageLength := Length(sMessage);
lNumberOfWords := (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) div BITS_TO_A_BYTE)) div (MODULUS_BITS div BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS div BITS_TO_A_WORD);
SetLength(lWordArray, lNumberOfWords);
lByteCount := 0;
While lByteCount < lMessageLength do begin
lWordCount := lByteCount div BYTES_TO_A_WORD;
lBytePosition := (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE;
lWordArray[lWordCount] := lWordArray[lWordCount] Or longword(Asc(sMessage[lByteCount + 1]) shl lBytePosition);
lByteCount := lByteCount + 1;
end;
lWordCount := lByteCount div BYTES_TO_A_WORD;
lBytePosition := (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE;
lWordArray[lWordCount] := lWordArray[lWordCount] or ($80 shl lBytePosition);
lWordArray[lNumberOfWords - 2] := lMessageLength shl 3;
lWordArray[lNumberOfWords - 1] := lMessageLength shr 29;
Result := lWordArray;
end;
class function sMD5.ConvToWord(const sMessage: string): arrlongword;
begin
Result := ConvToWord(WideString(sMessage));
end;
class function sMD5.MD5(const sMessage: string;
const sType: boolean = false): string;
const
S11 = 7;
S12 = 12;
S13 = 17;
S14 = 22;
S21 = 5;
S22 = 9;
S23 = 14;
S24 = 20;
S31 = 4;
S32 = 11;
S33 = 16;
S34 = 23;
S41 = 6;
S42 = 10;
S43 = 15;
S44 = 21;
var
k: integer;
AA, BB, CC, DD, a, b, c, d: longword;
x: arrlongword;
s: string;
{ functions }
function md5_F(const x, y, z: longword): longword;
begin
Result := (x And y) Or ((Not x) And z);
end;
function md5_G(const x, y, z: longword): longword;
begin
Result := (x And z) Or (y And (Not z));
end;
function md5_H(const x, y, z: longword): longword;
begin
Result := (x Xor y Xor z);
end;
function md5_I(const x, y, z: longword): longword;
begin
Result := (y Xor (x Or (Not z)));
end;
procedure md5_FF(var a: longword; const b, c, d, x, s, ac: longword);
begin
a := a + md5_F(b, c, d) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
procedure md5_GG(var a: longword; const b, c, d, x, s, ac: longword);
begin
a := a + md5_G(b, c, d) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
procedure md5_HH(var a: longword; const b, c, d, x, s, ac: longword);
begin
a := a + md5_H(b, c, d) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
procedure md5_II(var a: longword; const b, c, d, x, s, ac: longword);
begin
a := a + md5_I(b, c, d) + x + ac;
a := RotateLeft(a, s);
a := a + b;
end;
begin
{ MD5 }
x := ConvToWord(sMessage);
a := cAA;
b := cBB;
c := cCC;
d := cDD;
k := 0;
repeat
AA := a;
BB := b;
CC := c;
DD := d;
md5_FF(a, b, c, d, x[k + 0], S11, $D76AA478);
md5_FF(d, a, b, c, x[k + 1], S12, $E8C7B756);
md5_FF(c, d, a, b, x[k + 2], S13, $242070DB);
md5_FF(b, c, d, a, x[k + 3], S14, $C1BDCEEE);
md5_FF(a, b, c, d, x[k + 4], S11, $F57C0FAF);
md5_FF(d, a, b, c, x[k + 5], S12, $4787C62A);
md5_FF(c, d, a, b, x[k + 6], S13, $A8304613);
md5_FF(b, c, d, a, x[k + 7], S14, $FD469501);
md5_FF(a, b, c, d, x[k + 8], S11, $698098D8);
md5_FF(d, a, b, c, x[k + 9], S12, $8B44F7AF);
md5_FF(c, d, a, b, x[k + 10], S13, $FFFF5BB1);
md5_FF(b, c, d, a, x[k + 11], S14, $895CD7BE);
md5_FF(a, b, c, d, x[k + 12], S11, $6B901122);
md5_FF(d, a, b, c, x[k + 13], S12, $FD987193);
md5_FF(c, d, a, b, x[k + 14], S13, $A679438E);
md5_FF(b, c, d, a, x[k + 15], S14, $49B40821);
md5_GG(a, b, c, d, x[k + 1], S21, $F61E2562);
md5_GG(d, a, b, c, x[k + 6], S22, $C040B340);
md5_GG(c, d, a, b, x[k + 11], S23, $265E5A51);
md5_GG(b, c, d, a, x[k + 0], S24, $E9B6C7AA);
md5_GG(a, b, c, d, x[k + 5], S21, $D62F105D);
md5_GG(d, a, b, c, x[k + 10], S22, $2441453);
md5_GG(c, d, a, b, x[k + 15], S23, $D8A1E681);
md5_GG(b, c, d, a, x[k + 4], S24, $E7D3FBC8);
md5_GG(a, b, c, d, x[k + 9], S21, $21E1CDE6);
md5_GG(d, a, b, c, x[k + 14], S22, $C33707D6);
md5_GG(c, d, a, b, x[k + 3], S23, $F4D50D87);
md5_GG(b, c, d, a, x[k + 8], S24, $455A14ED);
md5_GG(a, b, c, d, x[k + 13], S21, $A9E3E905);
md5_GG(d, a, b, c, x[k + 2], S22, $FCEFA3F8);
md5_GG(c, d, a, b, x[k + 7], S23, $676F02D9);
md5_GG(b, c, d, a, x[k + 12], S24, $8D2A4C8A);
md5_HH(a, b, c, d, x[k + 5], S31, $FFFA3942);
md5_HH(d, a, b, c, x[k + 8], S32, $8771F681);
md5_HH(c, d, a, b, x[k + 11], S33, $6D9D6122);
md5_HH(b, c, d, a, x[k + 14], S34, $FDE5380C);
md5_HH(a, b, c, d, x[k + 1], S31, $A4BEEA44);
md5_HH(d, a, b, c, x[k + 4], S32, $4BDECFA9);
md5_HH(c, d, a, b, x[k + 7], S33, $F6BB4B60);
md5_HH(b, c, d, a, x[k + 10], S34, $BEBFBC70);
md5_HH(a, b, c, d, x[k + 13], S31, $289B7EC6);
md5_HH(d, a, b, c, x[k + 0], S32, $EAA127FA);
md5_HH(c, d, a, b, x[k + 3], S33, $D4EF3085);
md5_HH(b, c, d, a, x[k + 6], S34, $4881D05);
md5_HH(a, b, c, d, x[k + 9], S31, $D9D4D039);
md5_HH(d, a, b, c, x[k + 12], S32, $E6DB99E5);
md5_HH(c, d, a, b, x[k + 15], S33, $1FA27CF8);
md5_HH(b, c, d, a, x[k + 2], S34, $C4AC5665);
md5_II(a, b, c, d, x[k + 0], S41, $F4292244);
md5_II(d, a, b, c, x[k + 7], S42, $432AFF97);
md5_II(c, d, a, b, x[k + 14], S43, $AB9423A7);
md5_II(b, c, d, a, x[k + 5], S44, $FC93A039);
md5_II(a, b, c, d, x[k + 12], S41, $655B59C3);
md5_II(d, a, b, c, x[k + 3], S42, $8F0CCC92);
md5_II(c, d, a, b, x[k + 10], S43, $FFEFF47D);
md5_II(b, c, d, a, x[k + 1], S44, $85845DD1);
md5_II(a, b, c, d, x[k + 8], S41, $6FA87E4F);
md5_II(d, a, b, c, x[k + 15], S42, $FE2CE6E0);
md5_II(c, d, a, b, x[k + 6], S43, $A3014314);
md5_II(b, c, d, a, x[k + 13], S44, $4E0811A1);
md5_II(a, b, c, d, x[k + 4], S41, $F7537E82);
md5_II(d, a, b, c, x[k + 11], S42, $BD3AF235);
md5_II(c, d, a, b, x[k + 2], S43, $2AD7D2BB);
md5_II(b, c, d, a, x[k + 9], S44, $EB86D391);
a := a + AA;
b := b + BB;
c := c + CC;
d := d + DD;
k := k + 16;
until k > High(x);
if sType then
begin
s := WordToHex(a) + WordToHex(b) + WordToHex(c) + WordToHex(d)
end
else
begin
s := WordToHex(b) + WordToHex(c);
end;
Result := StrLower(PAnsiChar(s));
end;
class function sMD5.RotateLeft(const lValue, Bits: longword): longword;
begin
Result := (lValue shl Bits) Or (lValue shr (32 - Bits));
end;
class function sMD5.WordToHex(const lValue: longword): string;
var
s: string;
begin
s := inttohex(lValue, 8);
Result := s[7]+s[8]+s[5]+s[6]+s[3]+s[4]+s[1]+s[2];
end;
end.
软件注册的实现 delphi 源码相关推荐
- delphi Oracle导出多个表,Oracle数据库自动备份工具(Delphi源码)
Oracle数据库自动备份工具(Delphi源码) 下载地址:http://www.blogjava.net/Files/96sd2/OraSvr.rar 『OracleBackupService』简 ...
- delphi导入oracle数据库,Oracle数据库自动备份工具(Delphi源码)
Oracle数据库自动备份工具(Delphi源码) 下载地址:http://www.blogjava.net/Files/96sd2/OraSvr.rar 『OracleBackupService』简 ...
- 最新好看的自适应手机版软件APP下载类网站源码,游戏软件应用网站源码,自适应手机端Pbootcms模板
自适应手机软件APP下载类网站源码/游戏软件应用网站源码/自适应手机端 Pbootcms模板 测试环境:Linux nginx1.18 PHP7.3 下载地址:自适应手机端软件APP下载网站源码 ...
- 手zhuan手机软件app下载排行网站源码(需要自取)
demo软件园每日更新资源,请看到最后就能获取你想要的: 1.嵌入式Qt实战教程 PDF 高清版 嵌入式Qt实战教程 是配合Qt GUI程序设计的指导教材,独立于任何Qt编程教科书.主要内容有常用GU ...
- delphi源码转换为C++ Builder源码
本人80年代初出生,正好赶上电子信息高速发展的时代.记得刚接触的计算机高级语言就是PASCAL,但只是草草学了点语法.但开始接触C时,一发不可收拾,C->TBC->C++->BC++ ...
- 最新软件开发企业网站Pbootcms模板源码
正文: 最新软件开发企业网站Pbootcms模板源码+小程序开发代理展示 完整版演示图在压缩包,有兴趣自行去查看,本文只放了一部分. 这程序只需要把文字图片换成你自己的或者其他类型的网站的即可,PC+ ...
- 软件导航页源码+可封装APP/下载软件引流整站源码
正文: 完整标题: 源码介绍: APP软件应用下载导航网站源码/APP分享下载页引流导航网站源码带后台版 这款源码 安装非常便捷干净,源码只有十几MB 只需要上传源码修改数据库连接信息即可使用. 后台 ...
- 口袋Delphi源码
口袋Delphi源码 unit WgUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, C ...
- 安卓登录注册界面开发(附源码)
源码下载和博客访问:安卓登录注册界面开发(附源码) 前言 最近找安卓登录注册界面,找了好久也没找到比较满意的设计,最后想想其实登录和注册两个界面也不复杂,干脆花点时间自己弄. 界面预览 最后的效果如下 ...
最新文章
- Entity Framework 6 Recipes 2nd Edition(9-1)译-用Web Api更新单独分离的实体
- 腾讯云直播sdk_官方推荐 | 2分钟带你认识腾讯云直播 CSS
- 百度android定位 602 key mcode不匹配,我的Android进阶之旅------百度地图学习:BDLocation.getLocType ( )值分析...
- 【重识 HTML + CSS】基本 CSS 属性
- 为什么我们应该学马化腾,而不是马云
- python处理rgb_如何读取Python中给定像素的RGB值?
- 如何在没有电脑的情#况下用安卓手机制作windows pe启动盘
- 接口性能测试案例分析
- Android模拟器哪个稳定,哪个安卓模拟器好 什么安卓模拟器稳定流畅速度快不卡顿...
- 在SATA SSD + NVMe SSD双硬盘中安装ubuntu双系统
- 用MySQL绘制新年祝福图形_qq空间留言代码之新年祝福篇
- Nakagami分布
- 快速可靠网络传输协议 KCP
- js 防抖是什么 JavaScript防抖怎么用
- 轻音少女K-on闹钟,时钟,日历,整点报时
- ORACLE_CMD命令(最全的)
- vue生成html页面,前端VUE页面快速生成
- 熟读,理解,背诵,融会贯通!
- Configuration 'compile' is obsolete and has been replaced with 'implementati解决方案
- 声音放大器-系统软件下载
热门文章
- 自动监控网站消息动态并邮件通知 [附代码]
- 学习总结——注意力机制(transformer、DETR)
- 数字先锋 | 主机、硬盘、CPU统统没有? 这个电教室有点“潮”!
- GNOME 3没有桌面图标
- 14天精通TCPIP(持续更新中)-2
- Docker学习笔记--1.Docker原理、容器
- 轩小陌的Python笔记-day15 内置模块(剩余)和开发规范
- 拆解京东物流IPO:亏损十多年,原CEO王振辉在上市前被换掉
- idea中.ignore的配置
- 《所谓情商高,就是会说话》读书笔记(六)——应对语言暴力