unit1.pas

硬盘序列号GetIdeDiskSerialNumber

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

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 
      // Get 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; 

function GetDeviceHandle( sDeviceName : String ) : THandle;
begin
  Result := CreateFile( PChar('\\.\'+sDeviceName),
    GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil, OPEN_EXISTING, 0, 0 )
end;

//-------------------------------------------------------------
function ScsiHddSerialNumber( DeviceHandle : THandle ) : String;
{$ALIGN ON}
type
  TScsiPassThrough = record 
    Length             : Word; 
    ScsiStatus         : Byte;
    PathId             : Byte; 
    TargetId           : Byte;
    Lun                : Byte; 
    CdbLength          : Byte;
    SenseInfoLength    : Byte; 
    DataIn             : Byte; 
    DataTransferLength : ULONG;
    TimeOutValue       : ULONG;
    DataBufferOffset   : DWORD; 
    SenseInfoOffset    : ULONG; 
    Cdb                : Array[0..15] of Byte; 
  end;
  TScsiPassThroughWithBuffers = record 
    spt : TScsiPassThrough; 
    bSenseBuf : Array[0..31] of Byte; 
    bDataBuf : Array[0..191] of Byte;
  end;
{ALIGN OFF} 
var dwReturned : DWORD; 
    len : DWORD;
    Buffer : Array[0..255] of Byte; 
    sptwb : TScsiPassThroughWithBuffers absolute Buffer;
begin 
  Result := ''; 
  FillChar(Buffer,SizeOf(Buffer),#0);
  with sptwb.spt do 
  begin
    Length   := SizeOf(TScsiPassThrough);
    CdbLength := 6; // CDB6GENERIC_LENGTH 
    SenseInfoLength := 24;
    DataIn := 1; // SCSI_IOCTL_DATA_IN
    DataTransferLength := 192;
    TimeOutValue := 2;
    DataBufferOffset := PChar(@sptwb.bDataBuf)-PChar(@sptwb); 
    SenseInfoOffset := PChar(@sptwb.bSenseBuf)-PChar(@sptwb);
    Cdb[0] := $12; // OperationCode := SCSIOP_INQUIRY; 
    Cdb[1] := $01; // Flags := CDB_INQUIRY_EVPD;  Vital product data
    Cdb[2] := $80; // PageCode            Unit serial number
    Cdb[4] := 192; // AllocationLength 
  end;
  len := sptwb.spt.DataBufferOffset+sptwb.spt.DataTransferLength; 
  if DeviceIoControl( DeviceHandle, $0004d004, @sptwb, SizeOf
    (TScsiPassThrough), @sptwb, len, dwReturned, nil ) 
    and ((PChar(@sptwb.bDataBuf)+1)^=#$80)
  then 
   SetString( Result, PChar(@sptwb.bDataBuf)+4,
     Ord((PChar(@sptwb.bDataBuf)+3)^) ); 
end;

function getscsisn:string;
{const
  hDevice : THandle = 0;}
var
  sSerNum, sDeviceName : String;
  //rc : DWORD;
  hDevice : THandle;
begin
  sDeviceName := 'C:';
  hDevice := GetDeviceHandle(sDeviceName);
  if hDevice<>INVALID_HANDLE_VALUE then
    try
      SSerNum:=trim(GetIdeDiskSerialNumber);
      if SSernum=#39 then
      sSerNum := trim(ScsiHddSerialNumber(hDevice));
      result := sSerNum;
    finally
      CloseHandle(hDevice);
    end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := getscsisn;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Caption := GetIdeDiskSerialNumber;
end;

end.