Copy Code code as follows:
Reference and type variable declaration
Uses
Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms,
Dialogs, Stdctrls,nb30; {Important Reference}
Type
Pastat = ^tastat;
Tastat = Record
Adapter:tadapterstatus;
Name_buf:tnamebuffer;
End
TForm1 = Class (Tform)
Button1:tbutton;
Edit1:tedit;
Label1:tlabel;
Label2:tlabel;
Label3:tlabel;
Edit2:tedit;
Edit3:tedit;
Button2:tbutton;
Edit4:tedit;
Label4:tlabel;
Procedure Button1Click (Sender:tobject);
Procedure Button2click (Sender:tobject);
Private
{Private declarations}
Public
{Public declarations}
End
Var
Form1:tform1;
Implementation
{$R *.DFM}
Type
Tcpuid = array[1..4] of longint;
Take the hard drive serial number:
function Getideserialnumber:pchar; Get the factory serial number of the hard drive;
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 a 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 a 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);//procedure in a function
Var
Ptr:pchar;
I:integer;
C:char;
Begin
PTR: = @Data;
For I: = 0 to (Size shr 1)-1 does begin
c: = ptr^;
ptr^: = (ptr + 1) ^;
(ptr + 1) ^: = C;
Inc (PTR, 2);
End
End
Begin//function body
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 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: = $A 0;
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
//=================================================================
CPU Serial Number:
FUNCTION Getcpuid:tcpuid; Assembler; Register
Asm
PUSH EBX {Save affected Register}
PUSH EDI
MOV Edi,eax {@Resukt}
MOV eax,1
DW $A 20F {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 getcpuidstr:string;
Var
Cpuid:tcpuid;
Begin
Cpuid:=getcpuid;
Result:=inttohex (cpuid[1],8) +inttohex (cpuid[2],8) +inttohex (cpuid[3],8) +inttohex (cpuid[4],8);
End
///==================================================================================
Take Mac (non-integrated network adapter):
function Nbgetadapteraddress (A:integer): string;
Var
NCB:TNCB; Netbios control block//netbios
Adapter:tadapterstatus; Netbios Adapter status//Card Status
Lanaenum:tlanaenum; Netbios Lana
Intidx:integer; Temporary work value//temporary variable
Crc:char; Netbios return Code//netbios returned value
strtemp:string; Temporary string//temporary variable
Begin
Initialize
Result: = ';
Try
Zero Control BLOCL
ZeroMemory (@NCB, SizeOf (NCB));
Issue enum Command
Ncb.ncb_command: = Chr (Ncbenum);
CRC: = NetBios (@NCB);
Reissue enum Command
Ncb.ncb_buffer: = @LANAENUM;
Ncb.ncb_length: = SizeOf (Lanaenum);
CRC: = NetBios (@NCB);
If Ord (CRC) <> 0 Then
Exit
Reset Adapter
ZeroMemory (@NCB, SizeOf (NCB));
Ncb.ncb_command: = Chr (Ncbreset);
Ncb.ncb_lana_num: = Lanaenum.lana[a];
CRC: = NetBios (@NCB);
If Ord (CRC) <> 0 Then
Exit
Get Adapter Address
ZeroMemory (@NCB, SizeOf (NCB));
Ncb.ncb_command: = Chr (Ncbastat);
Ncb.ncb_lana_num: = Lanaenum.lana[a];
Strpcopy (Ncb.ncb_callname, ' * ');
Ncb.ncb_buffer: = @ADAPTER;
Ncb.ncb_length: = SizeOf (ADAPTER);
CRC: = NetBios (@NCB);
Convert it to string
strtemp: = ';
For intidx: = 0 to 5 do
strtemp: = strtemp + Inttohex (Integer (ADAPTER.ADAPTER_ADDRESS[INTIDX)), 2);
Result: = strtemp;
Finally
End
End
//==========================================================================
MAC address (integrated NIC and non-integrated NIC):
function getmac:string;
Var
NCB:TNCB;
s:string;
Adapt:tastat;
Lanaenum:tlanaenum;
I, J, M:integer;
Strpart, strmac:string;
Begin
Fillchar (NCB, SizeOf (TNCB), 0);
Ncb.ncb_command: = Char (Ncbenum);
Ncb.ncb_buffer: = Pchar (@lanaEnum);
Ncb.ncb_length: = SizeOf (Tlanaenum);
S:=netbios (@ncb);
For I: = 0 to Integer (lanaenum.length)-1 do
Begin
Fillchar (NCB, SizeOf (TNCB), 0);
Ncb.ncb_command: = Char (Ncbreset);
Ncb.ncb_lana_num: = Lanaenum.lana[i];
Netbios (@ncb);
Netbios (@ncb);
Fillchar (NCB, SizeOf (TNCB), 0);
Ncb.ncb_command: = Chr (Ncbastat);
Ncb.ncb_lana_num: = Lanaenum.lana[i];
Ncb.ncb_callname: = ' * ';
Ncb.ncb_buffer: = Pchar (@adapt);
Ncb.ncb_length: = SizeOf (Tastat);
m:=0;
if (Win32platform = ver_platform_win32_nt) Then
M:=1;
If M=1 Then
Begin
If Netbios (@ncb) = Chr (0) then
Strmac: = ';
For J: = 0 to 5 do
Begin
Strpart: = Inttohex (Integer (Adapt.adapter.adapter_address[j]), 2);
Strmac: = Strmac + Strpart + '-';
End
SetLength (Strmac, Length (STRMAC)-1);
End
If M=0 Then
If Netbios (@ncb) <> Chr (0) then
Begin
Strmac: = ';
For J: = 0 to 5 do
Begin
Strpart: = Inttohex (Integer (Adapt.adapter.adapter_address[j]), 2);
Strmac: = Strmac + Strpart + '-';
End
SetLength (Strmac, Length (STRMAC)-1);
End
End
Result:=strmac;
End
function partitionstring (strv,prtsymbol:string): tstringlist;
Var
Itemp:integer;
Begin
Result: = Tstringlist.create;
ITEMP: = pos (PRTSYMBOL,STRV);
While itemp>0 do begin
If itemp>1 then result. Append (copy (strv,1,itemp-1));
Delete (Strv,1,itemp+length (Prtsymbol)-1);
ITEMP: = pos (PRTSYMBOL,STRV);
End
If strv<> ' then result. Append (STRV);
End
function Macstr (): String;
Var
Str:tstrings;
I:integer;
macstr:string;
Begin
Macstr:= ';
Str:=tstringlist.create;
Str:=partitionstring (Getmac, '-');
For i:=0 to Str.count-1 do
Macstr:=macstr+str[i];
RESULT:=MACSTR;
End
//==============================================
Call Example
Procedure Tform1.button1click (Sender:tobject);
Begin
Edit3.text:=strpas (Getideserialnumber)//Hard Drive number
EDIT2.TEXT:=GETCPUIDSTR;//CPU Serial Number
Edit4. Text:=nbgetadapteraddress (12);//non-integrated NIC
edit1.text:=macstr;//integrated and non-integrated network adapters
End
