versionid.~pas

Delphi源码：获取计算机系统的逻辑硬盘号、物理硬盘号、Cpu号、Bios号等等。

    mov eax, 0
    db 0fh, 0a2h               // 其实就是cpuid汇编指令
    mov dword ptr R[0],  ebx
    mov dword ptr R[4],  edx
    mov dword ptr R[8],  ecx
    mov eax, 1
    db 0fh, 0a2h               // cpuid
    mov CpuID, edx
  end;
  ShowMessage('CPU制造商为：' + R);
  ShowMessage('序列号为：' + IntToStr(CpuID));
  //result:='SerialNo:' + IntToStr(CpuID);
end;

function BiosInfo:string;
const
  Subkey: string = 'Hardware\description\system';
var
  hkSB: HKEY;
  rType: LongInt;
  ValueSize, OrigSize: Longint;
  ValueBuf: array[0..1000] of char;
  strRet:string ;
  procedure ParseValueBuf(const VersionType: string);
  var
    I, Line: Cardinal;
    S: string;
  begin
    i := 0;
    Line := 0;
    while ValueBuf[i] <> #0 do
    begin
      S := StrPas(@ValueBuf[i]); // move the Pchar into a string
      Inc(Line);
      //Memo1.Lines.Append(Format('%s Line %d = %s',[VersionType, Line, S])); // add it to a Memo
        strRet:=strRet + 'VersionType:' + Format('%s Line %d = %s',[VersionType, Line, S]) + '; ';
      inc(i, Length(S) + 1);
      // to point to next sz, or to #0 if at
    end
  end;
//end;

  begin
    strRet:='' ;
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(Subkey), 0,
                    KEY_READ, hkSB) = ERROR_SUCCESS then
    try
      OrigSize := sizeof(ValueBuf);
      ValueSize := OrigSize;
      rType := REG_MULTI_SZ;
      if RegQueryValueEx(hkSB, 'SystemBiosVersion', nil, @rType,
        @ValueBuf, @ValueSize) = ERROR_SUCCESS then
        ParseValueBuf('System BIOS Version');

      ValueSize := OrigSize;
      rType := REG_SZ;
      if RegQueryValueEx(hkSB, 'SystemBIOSDate', nil, @rType,
        @ValueBuf, @ValueSize) = ERROR_SUCCESS then
        //Memo1.Lines.Append('System BIOS Date ' + ValueBuf);
        strRet:=strRet + ValueBuf ;

        {
      ValueSize := OrigSize;
      rType := REG_MULTI_SZ;
      if RegQueryValueEx(hkSB, 'VideoBiosVersion', nil, @rType,
        @ValueBuf, @ValueSize) = ERROR_SUCCESS then
        ParseValueBuf('Video BIOS Version');

      ValueSize := OrigSize;
      rType := REG_SZ;
      if RegQueryValueEx(hkSB, 'VideoBIOSDate', nil, @rType,
        @ValueBuf, @ValueSize) = ERROR_SUCCESS then
        //Memo1.Lines.Append(''Video BIOS Date '' + ValueBuf);
        strRet:=strRet + 'Video BIOS Date:'+ValueBuf ;
       }
  finally
      RegCloseKey(hkSB);
  end;
  result:=strRet ;
end;
 
{
function GetIdeDiskSerialNumber : String;
  type
    TSrbIoControl = packed record 
      HeaderLength : ULONG; 
      Signature    : Array[0..7] of Char; 
      Timeout      : ULONG; 
      ControlCode  : ULONG; 
      ReturnCode   : ULONG; 
      Length       : ULONG; 
    end; 
    SRB_IO_CONTROL = TSrbIoControl; 
    PSrbIoControl = ^TSrbIoControl; 
  
    TIDERegs = packed record 
      bFeaturesReg     : Byte; // Used for specifying SMART "commands". 
      bSectorCountReg  : Byte; // IDE sector count register 
      bSectorNumberReg : Byte; // IDE sector number register 
      bCylLowReg       : Byte; // IDE low order cylinder value 
      bCylHighReg      : Byte; // IDE high order cylinder value 
      bDriveHeadReg    : Byte; // IDE drive/head register 
      bCommandReg      : Byte; // Actual IDE command. 
      bReserved        : Byte; // reserved.  Must be zero. 
    end; 
    IDEREGS   = TIDERegs; 
    PIDERegs  = ^TIDERegs; 
  
    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; 
    SENDCMDINPARAMS   = TSendCmdInParams; 
    PSendCmdInParams  = ^TSendCmdInParams; 
  
    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    : ULONG; 
      wMultSectorStuff           : Word; 
      ulTotalAddressableSectors  : ULONG; 
      wSingleWordDMA             : Word; 
      wMultiWordDMA              : Word; 
      bReserved                  : Array[0..127] of Byte; 
    end; 
    PIdSector = ^TIdSector; 
  
  const 
    IDE_ID_FUNCTION = $EC; 
    IDENTIFY_BUFFER_SIZE       = 512; 
    DFP_RECEIVE_DRIVE_DATA        = $0007c088; 
    IOCTL_SCSI_MINIPORT           = $0004d008; 
    IOCTL_SCSI_MINIPORT_IDENTIFY  = $001b0501; 
    DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE; 
    BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize; 
    W9xBufferSize = IDENTIFY_BUFFER_SIZE+16; 
  var 
    hDevice : THandle; 
    cbBytesReturned : DWORD; 
    pInData : PSendCmdInParams; 
    pOutData : Pointer; // PSendCmdOutParams 
    Buffer : Array[0..BufferSize-1] of Byte; 
    srbControl : TSrbIoControl absolute Buffer; 
  
    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 := ''; 
    FillChar(Buffer,BufferSize,#0); 
    if Win32Platform=VER_PLATFORM_WIN32_NT then 
      begin // Windows NT, Windows 2000 
        // 获取 SCSI port handle 
        hDevice := CreateFile( '\\.\Scsi0:', 
          GENERIC_READ or GENERIC_WRITE, 
          FILE_SHARE_READ or FILE_SHARE_WRITE, 
          nil, OPEN_EXISTING, 0, 0 ); 
        if hDevice=INVALID_HANDLE_VALUE then Exit; 
        try 
          srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); 
          System.Move('SCSIDISK',srbControl.Signature,8); 
          srbControl.Timeout      := 2; 
          srbControl.Length       := DataSize; 
          srbControl.ControlCode  := IOCTL_SCSI_MINIPORT_IDENTIFY; 
          pInData := PSendCmdInParams(PChar(@Buffer) 
                     +SizeOf(SRB_IO_CONTROL)); 
          pOutData := pInData; 
          with pInData^ do 
          begin 
            cBufferSize  := IDENTIFY_BUFFER_SIZE; 
            bDriveNumber := 0; 
            with irDriveRegs do 
            begin 
              bFeaturesReg     := 0; 
              bSectorCountReg  := 1; 
              bSectorNumberReg := 1; 
              bCylLowReg       := 0; 
              bCylHighReg      := 0; 
              bDriveHeadReg    := $A0; 
              bCommandReg      := IDE_ID_FUNCTION; 
            end; 
          end; 
          if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, 
            @Buffer, BufferSize, @Buffer, BufferSize, 
            cbBytesReturned, nil ) then Exit; 
        finally 
          CloseHandle(hDevice); 
        end; 
      end 
    else 
      begin // Windows 95 OSR2, Windows 98 
        hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, 
          CREATE_NEW, 0, 0 ); 
        if hDevice=INVALID_HANDLE_VALUE then Exit; 
        try 
          pInData := PSendCmdInParams(@Buffer); 
          pOutData := @pInData^.bBuffer; 
          with pInData^ do 
          begin 
            cBufferSize  := IDENTIFY_BUFFER_SIZE; 
            bDriveNumber := 0; 
            with irDriveRegs do 
            begin 
              bFeaturesReg     := 0; 
              bSectorCountReg  := 1; 
              bSectorNumberReg := 1; 
              bCylLowReg       := 0; 
              bCylHighReg      := 0; 
              bDriveHeadReg    := $A0; 
              bCommandReg      := IDE_ID_FUNCTION; 
            end; 
          end; 
          if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, 
            pInData, SizeOf(TSendCmdInParams)-1, pOutData, 
            W9xBufferSize, cbBytesReturned, nil ) then Exit; 
        finally 
          CloseHandle(hDevice); 
        end; 
      end; 
      with PIdSector(PChar(pOutData)+16)^ do 
      begin 
        ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber)); 
        SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); 
      end; 
  end; 
  //=============================================================
var s : String;
    rc : DWORD;
begin
  s := GetIdeDiskSerialNumber;
  if s='' then
    begin
      rc := GetLastError;
      if rc=0 then WriteLn('IDE drive is not support SMART feature')
      else WriteLn(SysErrorMessage(rc));
    end
  else WriteLn('Disk serial number: ''', s,'''');
end;
}

function  GetHDserial:string ;
var
  SerialNum : dword;
  a, b : dword;
  Buffer  ,fname : array [0..255] of char;
begin
  if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), @SerialNum, a, b, fname, sizeof(fname)) then
      result:= IntToStr(SerialNum) else
      result:= '' ;
end;

end.