相关资料：

https://zhidao.baidu.com/question/195408580.html

 

注意事项：

1.记得右击以管理员运行。

2.SysUtils 在XE中要改为System.SysUtils。

 

实例代码：

1 unit Unit1;  2   3 interface  4   5 uses  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  7   Dialogs, StdCtrls, ExtCtrls, Vcl.Imaging.jpeg;  8   9 type 10   TForm1 = class(TForm) 11     Panel1: TPanel; 12     Memo1: TMemo; 13     Button1: TButton; 14     Label1: TLabel; 15     Image1: TImage; 16     procedure Button1Click(Sender: TObject); 17   private 18     {
      Private declarations } 19   public 20     {
      Public declarations } 21   end; 22  23 var 24   Form1: TForm1; 25  26 implementation 27  28 {
     $R *.dfm} 29  30 function GetScsiSerialNumber(const i: smallint): string; 31 type 32   TScsiPassThrough = record 33     Length: Word; 34     ScsiStatus: Byte; 35     PathId: Byte; 36     TargetId: Byte; 37     Lun: Byte; 38     CdbLength: Byte; 39     SenseInfoLength: Byte; 40     DataIn: Byte; 41     DataTransferLength: ULONG; 42     TimeOutValue: ULONG; 43     DataBufferOffset: DWORD; 44     SenseInfoOffset: ULONG; 45     Cdb: array[0..15] of Byte; 46   end; 47   TScsiPassThroughWithBuffers = record 48     spt: TScsiPassThrough; 49     bSenseBuf: array[0..31] of Byte; 50     bDataBuf: array[0..191] of Byte; 51   end; 52 var 53   dwReturned: DWORD; 54   len: DWORD; 55   Buffer: array[0..SizeOf(TScsiPassThroughWithBuffers) + SizeOf(TScsiPassThrough) - 1] of Byte; 56   sptwb: TScsiPassThroughWithBuffers absolute Buffer; 57   hDevice: thandle; 58 begin 59   Result := ''; 60   if SysUtils.win32Platform = VER_PLATFORM_WIN32_NT then 61   begin 62     if i = 0 then 63       hDevice := CreateFile('//./PhysicalDrive0', 64         GENERIC_READ or GENERIC_WRITE, 65         FILE_SHARE_READ or FILE_SHARE_WRITE, 66         nil, OPEN_EXISTING, 0, 0) 67     else 68       hDevice := CreateFile('//./PhysicalDrive1', 69         GENERIC_READ or GENERIC_WRITE, 70         FILE_SHARE_READ or FILE_SHARE_WRITE, 71         nil, OPEN_EXISTING, 0, 0); 72   end 73   else exit; 74   if hDevice = invalid_handle_value then exit; 75   FillChar(Buffer, SizeOf(Buffer), #0); 76   with sptwb.spt do 77   begin 78     Length := SizeOf(TScsiPassThrough); 79     CdbLength := 6; // CDB6GENERIC_LENGTH 80     SenseInfoLength := 24; 81     DataIn := 1; // SCSI_IOCTL_DATA_IN 82     DataTransferLength := 192; 83     TimeOutValue := 2; 84     DataBufferOffset := PChar(@sptwb.bDataBuf) - PChar(@sptwb); 85     SenseInfoOffset := PChar(@sptwb.bSenseBuf) - PChar(@sptwb); 86     Cdb[0] := $12; //  OperationCode := SCSIOP_INQUIRY; 87     Cdb[1] := $01; //  Flags := CDB_INQUIRY_EVPD;  Vital product data 88     Cdb[2] := $80; //  PageCode            Unit serial number 89     Cdb[4] := 192; // AllocationLength 90   end; 91   len := sptwb.spt.DataBufferOffset + sptwb.spt.DataTransferLength; 92   if DeviceIoControl(hDevice, $0004D004, @sptwb, SizeOf(TScsiPassThrough), @sptwb, len, dwReturned, nil) 93     and ((PChar(@sptwb.bDataBuf) + 1)^ = #$80) then 94     SetString(Result, PChar(@sptwb.bDataBuf) + 4, Ord((PChar(@sptwb.bDataBuf) + 3)^)); 95 end; 96  97 function GetIdeSerialNumber: pchar; 98 const IDENTIFY_BUFFER_SIZE = 512; 99 type100   TIDERegs = packed record101     bFeaturesReg: BYTE;102     bSectorCountReg: BYTE;103     bSectorNumberReg: BYTE;104     bCylLowReg: BYTE;105     bCylHighReg: BYTE;106     bDriveHeadReg: BYTE;107     bCommandReg: BYTE;108     bReserved: BYTE;109   end;110   TSendCmdInParams = packed record111     cBufferSize: DWORD;112     irDriveRegs: TIDERegs;113     bDriveNumber: BYTE;114     bReserved: array[0..2] of Byte;115     dwReserved: array[0..3] of DWORD;116     bBuffer: array[0..0] of Byte;117   end;118   TIdSector = packed record119     wGenConfig: Word;120     wNumCyls: Word;121     wReserved: Word;122     wNumHeads: Word;123     wBytesPerTrack: Word;124     wBytesPerSector: Word;125     wSectorsPerTrack: Word;126     wVendorUnique: array[0..2] of Word;127     sSerialNumber: array[0..19] of CHAR;128     wBufferType: Word;129     wBufferSize: Word;130     wECCSize: Word;131     sFirmwareRev: array[0..7] of Char;132     sModelNumber: array[0..39] of Char;133     wMoreVendorUnique: Word;134     wDoubleWordIO: Word;135     wCapabilities: Word;136     wReserved1: Word;137     wPIOTiming: Word;138     wDMATiming: Word;139     wBS: Word;140     wNumCurrentCyls: Word;141     wNumCurrentHeads: Word;142     wNumCurrentSectorsPerTrack: Word;143     ulCurrentSectorCapacity: DWORD;144     wMultSectorStuff: Word;145     ulTotalAddressableSectors: DWORD;146     wSingleWordDMA: Word;147     wMultiWordDMA: Word;148     bReserved: array[0..127] of BYTE;149   end;150   PIdSector = ^TIdSector;151   TDriverStatus = packed record152     bDriverError: Byte;153     bIDEStatus: Byte;154     bReserved: array[0..1] of Byte;155     dwReserved: array[0..1] of DWORD;156   end;157   TSendCmdOutParams = packed record158     cBufferSize: DWORD;159     DriverStatus: TDriverStatus;160     bBuffer: array[0..0] of BYTE;161   end;162   procedure ChangeByteOrder(var Data; Size: Integer);163   var164     ptr: Pchar;165     i: Integer;166     c: Char;167   begin168     ptr := @Data;169     for I := 0 to (Size shr 1) - 1 do begin170       c := ptr^;171       ptr^ := (ptr + 1)^;172       (ptr + 1)^ := c;173       Inc(ptr, 2);174     end;175   end;176 var177   hDevice: Thandle;178   cbBytesReturned: DWORD;179   SCIP: TSendCmdInParams;180   aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE - 1) - 1] of Byte;181   IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;182 begin183   Result := '';184   if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then185     //   Windows   NT,   Windows   2000186     hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,187       FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0)188   else189     //   Version   Windows   95   OSR2,   Windows   98190     hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);191   if hDevice = INVALID_HANDLE_VALUE then Exit;192   try193     FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);194     FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);195     cbBytesReturned := 0;196     with SCIP do begin197       cBufferSize := IDENTIFY_BUFFER_SIZE;198       with irDriveRegs do begin199         bSectorCountReg := 1;200         bSectorNumberReg := 1;201         bDriveHeadReg := $A0;202         bCommandReg := $EC;203       end;204     end;205     if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,206       @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;207   finally208     CloseHandle(hDevice);209   end;210   with PIdSector(@IdOutCmd.bBuffer)^ do begin211     ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));212     (Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^ := #0;213     Result := Pchar(@sSerialNumber);214   end;215 end;216 217 procedure TForm1.Button1Click(Sender: TObject);218 var219   stmp:String;220 begin221   //记得右击以管理员运行222   stmp := StrPas(PAnsiChar(GetIdeSerialNumber));223   if stmp<>'' then224   begin225     Memo1.Lines.Add('无参：' + stmp);226   end227   else228   begin229     stmp := Trim(GetScsiSerialNumber(0));230     Memo1.Lines.Add('有参:' + stmp);231   end;232 end;233 234 end.