Copy kode kodenya sebagai berikut:
//Deklarasi variabel referensi dan TYPE
kegunaan
Windows, Pesan, SysUtils, Varian, Kelas, Grafik, Kontrol, Formulir,
Dialog, StdCtrls,nb30; {Kutipan Penting}
jenis
PASTAT = ^TASTAT;
TASTAT=catatan
adaptor : TAdapterStatus;
nama_buf : TNameBuffer;
akhir;
TForm1 = kelas(TForm)
Tombol1: Tombol T;
Sunting1: TEdit;
Label1: Label;
Label2: TLabel;
Label3: Label;
Sunting2: TEdit;
Sunting3: TEdit;
Tombol2: Tombol T;
Sunting4: TEdit;
Label4: Label;
prosedur Button1Click(Pengirim: TObject);
prosedur Button2Click(Pengirim: TObject);
pribadi
{Deklarasi pribadi}
publik
{Pernyataan publik}
akhir;
var
Formulir1: TForm1;
pelaksanaan
{$R *.dfm}
jenis
TCPUID = array[1..4] dari Longint;
//Dapatkan nomor seri hard drive:
fungsi GetIdeSerialNumber: pchar; //Dapatkan nomor seri pabrik dari hard disk;
const IDENTIFY_BUFFER_SIZE = 512;
jenis
TIDERegs = catatan yang dikemas
bFiturReg: BYTE;
bSectorCountReg: BYTE;
bSectorNumberReg: BYTE;
bCylLowReg: BYTE;
bCylHighReg: BYTE;
bDriveHeadReg: BYTE;
bPerintahReg: BYTE;
bDipesan: BYTE;
akhir;
TSendCmdInParams = catatan yang dikemas
cBufferUkuran: DWORD;
irDriveRegs: TIDEReg;
bDriveNumber: BYTE;
bReserved: array[0..2] dari Byte;
dwReserved: array[0..3] dari DWORD;
bBuffer: array[0..0] dari Byte;
akhir;
TIdSector = catatan yang dikemas
wGenConfig: Kata;
wNumCyls: Kata;
dicadangkan: Kata;
wNumHeads: Kata;
wBytesPerTrack: Kata;
wBytesPerSector: Kata;
wSectorsPerTrack: Kata;
wVendorUnique: array[0..2] dari Word;
sSerialNumber: array[0..19] dari CHAR;
wBufferType: Kata;
wBufferSize: Kata;
wECCSUkuran: Kata;
sFirmwareRev: array[0..7] dari Char;
sModelNumber: array[0..39] dari Char;
wLebih BanyakVendorUnik: Kata;
wDoubleWordIO: Kata;
wKemampuan: Kata;
wReserved1: Kata;
wPIOTiming: Kata;
wDMATiming: Kata;
wBS: Kata;
wNumCurrentCyls: Kata;
wNumCurrentHeads: Kata;
wNumCurrentSectorsPerTrack: Kata;
ulKapasitas Sektor Saat Ini: DWORD;
wMultSectorStuff: Kata;
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: Kata;
wMultiWordDMA: Kata;
bDicadangkan: array[0..127] dari BYTE;
akhir;
PIdSector = ^TIdSector;
TDriverStatus = catatan yang dikemas
bDriverError: Byte;
status bidde: byte;
bReserved: array[0..1] dari Byte;
dwReserved: array[0..1] dari DWORD;
akhir;
TSendCmdOutParams = catatan yang dikemas
cBufferUkuran: DWORD;
Status Pengemudi: TDriverStatus;
bBuffer: array[0..0] dari BYTE;
akhir;
var
hPerangkat: Thandle;
cbBytesDikembalikan: DWORD;
SCIP:TSendCmdInParams;
aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] Byte;
IdOutCmd: TSendCmdOutParams mutlak aIdOutCmd;
procedure ChangeByteOrder(var Data; Size: Integer);//Proses dalam fungsi
var
ptr: Pchar;
saya: Bilangan bulat;
c: Arang;
mulai
ptr := @Data;
untuk I := 0 sampai (Ukuran shr 1) - 1 dimulai
c := ptr^;
ptr^ := (ptr+1)^;
(ptr + 1)^ := c;
Inc(ptr, 2);
akhir;
akhir;
mulai //fungsi tubuh
Hasil := '';
jika SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT maka
mulai // Windows NT, Windows 2000
hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ atau GENERIC_WRITE,
FILE_SHARE_READ atau FILE_SHARE_WRITE, nihil, OPEN_EXISTING, 0, 0);
akhir
lain // Versi Windows 95 OSR2, Windows 98
hDevice := CreateFile('//./SMARTVSD', 0, 0, nihil, Create_NEW, 0, 0);
jika hDevice = INVALID_HANDLE_VALUE lalu Keluar;
mencoba
FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
cbBytesDikembalikan := 0;
dengan SCIP lakukan
mulai
cBufferSize := IDENTIFIKASI_BUFFER_SIZE;
dengan irDriveRegs lakukan
mulai
bSectorCountReg := 1;
bSectorNumberReg := 1;
bDriveHeadReg := $A0;
bCommandReg := $EC;
akhir;
akhir;
jika bukan DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) lalu Keluar;
Akhirnya
CloseHandle(hPerangkat);
akhir;
dengan PIdSector(@IdOutCmd.bBuffer)^ lakukan
mulai
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
Hasil := Pchar(@sSerialNumber);
akhir;
akhir;
//------------------------------------------------ ==
//Nomor seri CPU:
FUNGSI GetCPUID : TCPUID; register perakit;
asm
PUSH EBX {Simpan register yang terpengaruh}
DORONG EDI
MOV EDI,EAX {@Resukt}
MOV EAX,1
DW $A20F {Perintah CPUID}
STOSD {CPUID[1]}
PINDAHKAN EAX,EBX
STOSD {CPUID[2]}
PINDAHKAN EAX,ECX
STOSD {CPUID[3]}
PINDAHKAN EAX,EDX
STOSD {CPUID[4]}
POP EDI {Pulihkan register}
POPEBX
AKHIR;
fungsi GetCPUIDStr:String;
var
ID CPU:TCPUID;
mulai
CPUID:=DapatkanCPUID;
Hasil:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
akhir;
///================= = =====
///Dapatkan MAC (kartu jaringan tidak terintegrasi):
fungsi NBGetAdapterAddress(a: Integer): string;
var
NCB: TNCB; // Blok kendali Netbios // Blok kendali NetBios
ADAPTER: TADAPTERSSTATUS; // Status adaptor Netbios//Dapatkan status kartu jaringan
LANAENUM: TLANAENUM; // Netbios lana
intIdx: Integer; // Nilai pekerjaan sementara // Variabel sementara
cRC: Char; // Kode pengembalian Netbios // Nilai pengembalian NetBios
strTemp: string; // String sementara//Variabel sementara
mulai
//Inisialisasi
Hasil := '';
mencoba
// Blok kontrol nol
ZeroMemory(@NCB, SizeOf(NCB));
// Keluarkan perintah enum
NCB.ncb_command := Chr(NCBENUM);
cRC := NetBios(@NCB);
// Keluarkan ulang perintah enum
NCB.ncb_buffer := @LANAENUM;
NCB.ncb_length := SizeOf(LANAENUM);
cRC := NetBios(@NCB);
jika ord(cRC) <> 0 maka
KELUAR;
//Setel ulang adaptor
ZeroMemory(@NCB, SizeOf(NCB));
NCB.ncb_command := Chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana[a];
cRC := NetBios(@NCB);
jika ord(cRC) <> 0 maka
KELUAR;
// Dapatkan alamat adaptor
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);
// Ubah menjadi string
strTemp := '';
untuk intIdx := 0 hingga 5 lakukan
strTemp := strTemp + InttoHex(Bilangan Bulat(ADAPTER.adapter_address[intIdx]), 2);
Hasil := strTemp;
Akhirnya
akhir;
akhir;
//------------------------------------------------ ===========
//Dapatkan alamat MAC (kartu jaringan terintegrasi dan kartu jaringan tidak terintegrasi):
fungsi Getmac:string;
var
ncb: TNCB;
s:tali;
beradaptasi: TASTAT;
lanaEnum : TLanaEnum;
i, j, m : bilangan bulat;
strPart, strMac : tali;
mulai
IsiChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length := SizeOf(TLanaEnum);
s:=Netbios(@ncb);
untuk i := 0 hingga integer(lanaEnum.length)-1 lakukan
mulai
IsiChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBRReset);
ncb.ncb_lana_num := lanaEnum.lana[i];
Netbios(@ncb);
Netbios(@ncb);
IsiChar(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;
jika (Win32Platform = VER_PLATFORM_WIN32_NT) maka
m:=1;
jika m=1 maka
mulai
jika Netbios(@ncb) = Chr(0) maka
strMac := '';
untuk j := 0 sampai 5 lakukan
mulai
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
akhir;
SetLength(strMac, Panjang(strMac)-1);
akhir;
jika m=0 maka
jika Netbios(@ncb) <> Chr(0) maka
mulai
strMac := '';
untuk j := 0 sampai 5 lakukan
mulai
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
akhir;
SetLength(strMac, Panjang(strMac)-1);
akhir;
akhir;
hasil:=strmac;
akhir;
fungsi PartitionString(StrV,PrtSymbol: string): TStringList;
var
iTemp: bilangan bulat;
mulai
hasil := TStringList.Buat;
iTemp := pos(PrtSimbol,StrV);
sementara iTemp>0 dimulai
jika iTemp>1 maka result.Append(copy(StrV,1,iTemp-1));
hapus(StrV,1,iTemp+panjang(PrtSymbol)-1);
iTemp := pos(PrtSimbol,StrV);
akhir;
jika Strv<>'' maka hasil.Append(StrV);
akhir;
fungsi MacStr():String;
var
Str:Tstring;
saya:Bilangan Bulat;
MacStr:String;
mulai
MacStr:='';
Str:=TStringList.Buat;
Str:=PartitionString(Getmac,'-');
untuk i:=0 hingga Str.Count-1 lakukan
MacStr:=MacStr+Str[i];
Hasil:=MacStr;
akhir;
//================
//Contoh panggilan
prosedur TForm1.Button1Click(Pengirim: TObject);
mulai
Edit3.Text:=strpas(GetIdeSerialNumber);//Dapatkan nomor hard disk
Edit2.text:=GetCPUIDStr;//nomor seri CPU
edit4.Text:=NBGetAdapterAddress(12);//Kartu jaringan tidak terintegrasi
Edit1.text:=MacStr;//Kartu jaringan terintegrasi dan tidak terintegrasi
akhir;