获得硬盘的ID序列号(XE10.1+WIN8.1)

  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 type
100   TIDERegs = packed record
101     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 record
111     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 record
119     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 record
152     bDriverError: Byte;
153     bIDEStatus: Byte;
154     bReserved: array[0..1] of Byte;
155     dwReserved: array[0..1] of DWORD;
156   end;
157   TSendCmdOutParams = packed record
158     cBufferSize: DWORD;
159     DriverStatus: TDriverStatus;
160     bBuffer: array[0..0] of BYTE;
161   end;
162   procedure ChangeByteOrder(var Data; Size: Integer);
163   var
164     ptr: Pchar;
165     i: Integer;
166     c: Char;
167   begin
168     ptr := @Data;
169     for I := 0 to (Size shr 1) - 1 do begin
170       c := ptr^;
171       ptr^ := (ptr + 1)^;
172       (ptr + 1)^ := c;
173       Inc(ptr, 2);
174     end;
175   end;
176 var
177   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 begin
183   Result := '';
184   if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
185     //   Windows   NT,   Windows   2000
186     hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
187       FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0)
188   else
189     //   Version   Windows   95   OSR2,   Windows   98
190     hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
191   if hDevice = INVALID_HANDLE_VALUE then Exit;
192   try
193     FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
194     FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
195     cbBytesReturned := 0;
196     with SCIP do begin
197       cBufferSize := IDENTIFY_BUFFER_SIZE;
198       with irDriveRegs do begin
199         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   finally
208     CloseHandle(hDevice);
209   end;
210   with PIdSector(@IdOutCmd.bBuffer)^ do begin
211     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 var
219   stmp:String;
220 begin
221   //记得右击以管理员运行
222   stmp := StrPas(PAnsiChar(GetIdeSerialNumber));
223   if stmp<>'' then
224   begin
225     Memo1.Lines.Add('无参：' + stmp);
226   end
227   else
228   begin
229     stmp := Trim(GetScsiSerialNumber(0));
230     Memo1.Lines.Add('有参:' + stmp);
231   end;
232 end;
233 
234 end.