手机
当前位置:查字典教程网 >编程开发 >Delphi >DELPHI7.0 获取硬盘、CPU、网卡序列号的代码
DELPHI7.0 获取硬盘、CPU、网卡序列号的代码
摘要:复制代码代码如下://引用及TYPE变量申明usesWindows,Messages,SysUtils,Variants,Classes,G...

复制代码 代码如下:

//引用及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;

【DELPHI7.0 获取硬盘、CPU、网卡序列号的代码】相关文章:

Delphi下OpenGL2d绘图之画点的方法

Delphi实现判断网址是否存在及是否可以打开的方法

delphi mysql adbquery数据提供程序或其他服务返回 E_FAIL 状态

Delphi控件ListView的属性及使用方法详解

delphi实现保存和读取图片的方法

插件管理框架 for Delphi(一)

Delphi实现图像文本旋转特效完整实例代码

Delphi7中Listview的常用功能汇总

Delphi实现读取系统时间与日期完整实例

delphi中一个值得大家来考虑的DLL问题

精品推荐
分类导航