Delphi ProgramReg.pas
指尖风暴 unit ProgramReg;
interface
uses StdCtrls, Buttons, Controls, Classes,
Windows, Messages, SysUtils, Variants, Graphics, Forms,
Dialogs,Nb30,md5;
type
TGetSN =function(HardType: integer):WideString; stdcall;
TForm_ProgReg = class(TForm)
grp2: TGroupBox;
lbl7: TLabel;
lbl6: TLabel;
lbl8: TLabel;
edtRegKey: TEdit;
edtRegUser: TEdit;
edtRegIdeId: TEdit;
grp1: TGroupBox;
grp3: TGroupBox;
Label2: TLabel;
btnReg: TBitBtn;
BitBtn2: TBitBtn;
Button1: TButton;
procedure BitBtn2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function GetIdeSerialNumber: pchar;//获取第一个IDE硬盘序列号函数
function GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte): String; //获取盘符序列号
function NbGetMac():string ;
function GetCPUInfo(InfoID:Byte=1) : String;//取CPU信息：1、CPU序列号；2、CPU 频率；3、CPU 厂商
function RivestStr(Str: string): string;
var
Form_ProgReg: TForm_ProgReg;
implementation
{$R *.dfm}
procedure TForm_ProgReg.BitBtn2Click(Sender: TObject);
begin
close;
end;
//-----------------------------------------------------------------------
//获取CPU硬件信息
//-----------------------------------------------------------------------
//参数：
// InfoID:=1 获取CPU序列号
// InfoID:=2 获取CPU 频率
// InfoID:=3 获取CPU厂商
//-----------------------------------------------------------------------
function GetCPUInfo(InfoID: Byte): String;
var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
// b1: Word;
s, s1, s2, s3, s_all: string;
begin
case InfoID of //获取CPU序列号
1:
begin
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := IntToHex(_eax, 8);
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
result:=s + '-' + s1 + '-' + s2;
end;
2: //获取 CPU 频率
begin
asm //execute the extended CPUID inst.
mov eax,$80000000 //sub. func call
db $0F,$A2
mov _eax,eax
end;
if _eax > $80000000 then //any other sub. funct avail. ?
begin
asm //get brand ID
mov eax,$80000002
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3:= s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := trim(s3 + s + s1 + s2);
asm
mov eax,$80000003
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s_all + s3 + s + s1 + s2;
asm
mov eax,$80000004
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
result:= s_all + s3 + s + s1 + s2;
end
else
result:= '';
end;
3: //获取 CPU厂商
begin
asm //asm call to the CPUID inst.
mov eax,0 //sub. func call
db $0F,$A2 //db $0F,$A2 = CPUID instruction
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
for i := 0 to 3 do //extract vendor id
begin
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1:= s1 + chr(b);
b := lo(_edx);
s2:= s2 + chr(b);
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
result:=s + s2 + s1;
end;
else
result:='错误的信息标识!';
end;
end;
//获取第一个IDE硬盘的序列号
function GetIdeSerialNumber : pchar;
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
// Buffer size in bytes
cBufferSize : DWORD;
// Structure with drive register values.
irDriveRegs : TIDERegs;
// Physical drive number to send command to (0,1,2,3).
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
// 驱动器返回的错误代码，无错则返回0
bDriverError : Byte;
// IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
bIDEStatus : Byte;
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
// bBuffer的大小
cBufferSize : DWORD;
// 驱动器状态
DriverStatus : TDriverStatus;
// 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
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 := ''; // 如果出错则返回空串
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
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;
// Set up data structures for IDENTIFY command.
with SCIP do begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
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;
// 更多关于 S.M.A.R.T. ioctl 的信息可查看:
// http://www.microsoft.com/hwdev/download/respec/iocltapi.rtf
// MSDN库中也有一些简单的例子
// Windows Development -> Win32 Device Driver Kit ->
// SAMPLE: SmartApp.exe Accesses SMART stats in IDE drives
// 还可以查看 http://www.mtgroup.ru/~alexk
// IdeInfo.zip - 一个简单的使用了S.M.A.R.T. Ioctl API的Delphi应用程序
// 注意:
// WinNT/Win2000 - 你必须拥有对硬盘的读/写访问权限
// Win98
// SMARTVSD.VXD 必须安装到 \windows\system\iosubsys
// (不要忘记在复制后重新启动系统)
//-----------------------------------------------------------------------
//获取硬盘驱动器信息
//-----------------------------------------------------------------------
//参数：
// Drive 驱动器盘符 如C、D、E，不要带 :\
// InfoID =1 获取驱动器序列号 InfoID =2 获取卷标
//-----------------------------------------------------------------------
function GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte): String;
var
NotUsed: DWORD;
VolumeFlags: DWORD;
VolumeInfo: array[0..MAX_PATH] of Char;
VolumeSerialNumber: DWORD;
begin
try
GetVolumeInformation(PChar(Drive + ':\'),
VolumeInfo, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
VolumeFlags, nil, 0);
case InfoID of
1: Result:= Format('%8.8X', [VolumeSerialNumber]);
2: Result:= VolumeInfo;
else
result:='错误的信息标识!';
end;
except on E: Exception do
result:='执行错误!';
end;
end;
//取得网卡MAC地址
function NbGetMac():string ;
function hexbl(by:byte):string;
begin
result:=format('%x',[by]);
if length(result)<2 then
result:='0'+result;
end;
var
ncb:Tncb;
i,j:integer;
adapter:TAdapterstatus;
lanaenum:TLanaEnum;
strx:string;
begin
zeromemory(@ncb,sizeof(ncb));
ncb.ncb_command:=chr(ncbenum);
netbios(@ncb);
ncb.ncb_buffer:=@lanaenum;
ncb.ncb_length:=sizeof(lanaenum);
ncb.ncb_command :=chr(ncbenum);
netbios(@ncb);
strx:='' ;
for i:=0 to ord(lanaenum.length)-1 do
begin
zeromemory(@ncb,sizeof(ncb));
ncb.ncb_command:=chr(ncbreset);
ncb.ncb_lana_num:=lanaenum.lana[i];
netbios(@ncb);
zeromemory(@ncb,sizeof(ncb));
ncb.ncb_command:=chr(ncbastat);
ncb.ncb_lana_num:=lanaenum.lana[i];
strcopy(ncb.ncb_callname,'*');
ncb.ncb_buffer :=@adapter;
ncb.ncb_length :=sizeof(adapter);
netbios(@ncb);
for j:=0 to 5 do
begin
//if j>0 then strx:=strx+'-';
strx:=strx+hexbl(byte(adapter.adapter_address[j]));
end;
strx:=strx + ';' ;
end;
if strx<>'' then strx:=copy(strx,1,length(strx) - 1) ;
result:=strx;
end;
function GetHDserial:string ;
var
SerialNum : dword;
a, b : dword;
Buffer ,fname : array [0..255] of char;
begin
if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), @SerialNum, a, b, fname, sizeof(fname)) then
result:= IntToStr(SerialNum) else
result:= '' ;
end;
function RivestStr(Str: string): string;
begin
Result := MD5Print(MD5String(Str));
end;
procedure TForm_ProgReg.Button1Click(Sender: TObject);
begin
edtRegIdeId.Text:=trim(GetCPUInfo(1));
// edtRegIdeId.Text:=trim(GetIdeSerialNumber)+'-'+trim(NbGetMac)+'-'+trim(GetHDserial);
edtRegKey.Text:= RivestStr(edtRegIdeId.Text+edtRegUser.Text);
end;
end.
声明：本站所有文章，如无特殊说明或标注，均为本站原创发布。任何个人或组织，在未征得本站同意时，禁止复制、盗用、采集、发布本站内容到任何网站、书籍等各类媒体平台。如若本站内容侵犯了原著者的合法权益，可联系我们进行处理。
