获取CPU系列号,硬盘系

unit Secrity;  
  
interface  
  
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;  
  
    procedure Button1Click(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  
  
//Edit1.Text:=strpas(GetIdeSerialNumber)//取硬盘号  
  
//Edit1.text:=GetCPUIDStr;//CPU系列号  
  
//edit1.Text:=NBGetAdapterAddress(12);//非集成网卡  
  
Edit1.text:=MacStr;//集成和非集成网卡  
  
end;