DELPHI7.0获取硬盘、CPU、网卡序列号

最新推荐文章于 2021-04-13 19:55:50 发布

xxagri

最新推荐文章于 2021-04-13 19:55:50 发布

阅读量953

点赞数

文章标签： delphi integer command byte buffer button

DELPHI7.0获取硬盘、CPU、网卡序列号
//引用及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;
    Netbios(@ncb);
    Netbios(@ncb);
    FillChar(ncb, SizeOf(TNCB), 0);
    ncb.ncb_command := Chr(NCBAstat);
    ncb.ncb_lana_num := lanaEnum.lana;
    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;
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;