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[..] of Longint;  

//取硬盘系列号:  

function GetIdeSerialNumber: pchar; //获取硬盘的出厂系列号；  

const IDENTIFY_BUFFER_SIZE = ;  

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[..] of Byte;  

    dwReserved: array[..] of DWORD;  

    bBuffer: array[..] of Byte;  

end;  

TIdSector = packed record  

    wGenConfig: Word;  

    wNumCyls: Word;  

    wReserved: Word;  

    wNumHeads: Word;  

    wBytesPerTrack: Word;  

    wBytesPerSector: Word;  

    wSectorsPerTrack: Word;  

    wVendorUnique: array[..] of Word;  

    sSerialNumber: array[..] of CHAR;  

    wBufferType: Word;  

    wBufferSize: Word;  

    wECCSize: Word;  

    sFirmwareRev: array[..] of Char;  

    sModelNumber: array[..] 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[..] of BYTE;  

end;  

PIdSector = ^TIdSector;  

TDriverStatus = packed record  

    bDriverError: Byte;  

    bIDEStatus: Byte;  

    bReserved: array[..] of Byte;  

    dwReserved: array[..] of DWORD;  

end;  

TSendCmdOutParams = packed record  

    cBufferSize: DWORD;  

    DriverStatus: TDriverStatus;  

    bBuffer: array[..] of BYTE;  

end;  

var  

hDevice: Thandle;  

cbBytesReturned: DWORD;  

SCIP: TSendCmdInParams;  

aIdOutCmd: array[..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-)-] of Byte;  

IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;  

procedure ChangeByteOrder(var Data; Size: Integer);  

var  

ptr: Pchar;  

i: Integer;  

c: Char;  

begin  

ptr := @Data;  

for I :=  to (Size shr ) -  do begin  

    c := ptr^;  

    ptr^ := (ptr + )^;  

    (ptr + )^ := c;  

    Inc(ptr, );  

end;  

end;  

begin  

    Result := '';  

    if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then  

       begin // Windows NT, Windows   

         hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,  

         FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, , );  

       end  

    else // Version Windows  OSR2, Windows   

       hDevice := CreateFile('//./SMARTVSD', , , nil, CREATE_NEW, , );  

    if hDevice = INVALID_HANDLE_VALUE then Exit;  

    try  

      FillChar(SCIP, SizeOf(TSendCmdInParams) - , #);  

      FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #);  

      cbBytesReturned := ;  

      with SCIP do  

      begin  

        cBufferSize := IDENTIFY_BUFFER_SIZE;  

        with irDriveRegs do  

        begin  

          bSectorCountReg := ;  

          bSectorNumberReg := ;  

          bDriveHeadReg := $A0;  

          bCommandReg := $EC;  

        end;  

      end;  

      if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - ,@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))^:= #;  

      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,  

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[],)+IntToHex(CPUID[],)+IntToHex(CPUID[],)+IntToHex(CPUID[],);  

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) <>  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) <>  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 :=  to  do  

      strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), );  

    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), );  

ncb.ncb_command := Char(NCBEnum);  

ncb.ncb_buffer := PChar(@lanaEnum);  

ncb.ncb_length := SizeOf(TLanaEnum);  

s:=Netbios(@ncb);  

for i :=  to integer(lanaEnum.length)- do  

begin  

    FillChar(ncb, SizeOf(TNCB), );  

    ncb.ncb_command := Char(NCBReset);  

    ncb.ncb_lana_num := lanaEnum.lana[i];  

    Netbios(@ncb);  

    Netbios(@ncb);  

    FillChar(ncb, SizeOf(TNCB), );  

    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:=;  

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then  

    m:=;  

    if m= then  

    begin  

    if Netbios(@ncb) = Chr() then  

      strMac := '';  

      for j :=  to  do  

      begin  

        strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), );  

        strMac := strMac + strPart + '-';  

      end;  

      SetLength(strMac, Length(strMac)-);  

    end;  

if m= then  

    if Netbios(@ncb) <> Chr() then  

    begin  

      strMac := '';  

      for j :=  to  do  

      begin  

        strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), );  

        strMac := strMac + strPart + '-';  

      end;  

      SetLength(strMac, Length(strMac)-);  

    end;  

end;  

result:=strmac;  

end;  

function PartitionString(StrV,PrtSymbol: string): TStringList;  

var  

iTemp: integer;  

begin  

result := TStringList.Create;  

iTemp := pos(PrtSymbol,StrV);  

while iTemp> do begin  

    if iTemp> then result.Append(copy(StrV,,iTemp-));  

    delete(StrV,,iTemp+length(PrtSymbol)-);  

    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:= to Str.Count- 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();//非集成网卡  

Edit1.text:=MacStr;//集成和非集成网卡  

end;