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;