DELPHI7.0 獲取硬盤、CPU、網卡序列號的代碼

2020-01-31 20:52:23

字體：大中小

來源：轉載

供稿：網友

//引用及TYPE變量申明 

uses 
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
Dialogs, StdCtrls,nb30; {重要引用} 

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; 

//取硬盤系列號: 
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; 
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 // 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 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; 
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; 
//================================================================= 

//CPU系列號: 
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 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; 

///================================================================================== 

///取MAC(非集成網卡): 

function NBGetAdapterAddress(a: Integer): string; 
var 
NCB: TNCB; // Netbios control block //NetBios控制塊 
ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取網卡狀態 
LANAENUM: TLANAENUM; // Netbios lana 
intIdx: Integer; // Temporary work value//臨時變量 
cRC: Char; // Netbios return code//NetBios返回值 
strTemp: string; // Temporary string//臨時變量 
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地址(集成網卡和非集成網卡): 

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; 

//============================================== 


//調用示例 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
Edit3.Text:=strpas(GetIdeSerialNumber);//取硬盤號 
Edit2.text:=GetCPUIDStr;//CPU系列號 
edit4.Text:=NBGetAdapterAddress(12);//非集成網卡 
Edit1.text:=MacStr;//集成和非集成網卡 

end;