unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, Vcl.Imaging.jpeg;

type

  TForm1 = class(TForm)

    Panel1: TPanel;

    Memo1: TMemo;

    Button1: TButton;

    Label1: TLabel;

    Image1: TImage;

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

function GetScsiSerialNumber(const i: smallint): string;

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

  end;

  TScsiPassThroughWithBuffers = record

    spt: TScsiPassThrough;

    bSenseBuf: array[..] of Byte;

    bDataBuf: array[..] of Byte;

  end;

var

  dwReturned: DWORD;

  len: DWORD;

  Buffer: array[..SizeOf(TScsiPassThroughWithBuffers) + SizeOf(TScsiPassThrough) - ] of Byte;

  sptwb: TScsiPassThroughWithBuffers absolute Buffer;

  hDevice: thandle;

begin

  Result := '';

  if SysUtils.win32Platform = VER_PLATFORM_WIN32_NT then

  begin

    if i =  then

      hDevice := CreateFile('//./PhysicalDrive0',

        GENERIC_READ or GENERIC_WRITE,

        FILE_SHARE_READ or FILE_SHARE_WRITE,

        nil, OPEN_EXISTING, , )

    else

      hDevice := CreateFile('//./PhysicalDrive1',

        GENERIC_READ or GENERIC_WRITE,

        FILE_SHARE_READ or FILE_SHARE_WRITE,

        nil, OPEN_EXISTING, , );

  end

  else exit;

  if hDevice = invalid_handle_value then exit;

  FillChar(Buffer, SizeOf(Buffer), #);

  with sptwb.spt do

  begin

    Length := SizeOf(TScsiPassThrough);

    CdbLength := ; // CDB6GENERIC_LENGTH

    SenseInfoLength := ;

    DataIn := ; // SCSI_IOCTL_DATA_IN

    DataTransferLength := ;

    TimeOutValue := ;

    DataBufferOffset := PChar(@sptwb.bDataBuf) - PChar(@sptwb);

    SenseInfoOffset := PChar(@sptwb.bSenseBuf) - PChar(@sptwb);

    Cdb[] := $; //  OperationCode := SCSIOP_INQUIRY;

    Cdb[] := $; //  Flags := CDB_INQUIRY_EVPD;  Vital product data

    Cdb[] := $; //  PageCode            Unit serial number

    Cdb[] := ; // AllocationLength

  end;

  len := sptwb.spt.DataBufferOffset + sptwb.spt.DataTransferLength;

  if DeviceIoControl(hDevice, $0004D004, @sptwb, SizeOf(TScsiPassThrough), @sptwb, len, dwReturned, nil)

    and ((PChar(@sptwb.bDataBuf) + )^ = #$) then

    SetString(Result, PChar(@sptwb.bDataBuf) + , Ord((PChar(@sptwb.bDataBuf) + )^));

end;

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;

  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;

var

  hDevice: Thandle;

  cbBytesReturned: DWORD;

  SCIP: TSendCmdInParams;

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

  IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;

begin

  Result := '';

  if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then

    //   Windows   NT,   Windows   2000

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

      FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, , )

  else

    //   Version   Windows   95   OSR2,   Windows   98

    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;

procedure TForm1.Button1Click(Sender: TObject);

var

  stmp:String;

begin

  //记得右击以管理员运行

  stmp := StrPas(PAnsiChar(GetIdeSerialNumber));

  if stmp<>'' then

  begin

    Memo1.Lines.Add('无参：' + stmp);

  end

  else

  begin

    stmp := Trim(GetScsiSerialNumber());

    Memo1.Lines.Add('有参:' + stmp);

  end;

end;

end.