From long time ago, but since I needed it in Delphi 2007 again: [WayBack] delphi – in Delphi7, How can I retrieve hard disk unique serial number? – Stack Overflow:
Following the links in the question comments Sertac posted, I came across this interesting C++ question, where Fredou answered with a nice link to a codeproject example showing how to do this in .NET, which in turn was based on a link to Borland C++ code and article.
The cool thing is that this C++ code works as a non-administrator user too!
Now you need someone to help you translate this C++ code to Delphi.
Edit: Found a Delphi unit that does this for you.
I wrote some sample use for it:
program DiskDriveSerialConsoleProject; {$APPTYPE CONSOLE} uses Windows, SysUtils, hddinfo in 'hddinfo.pas'; const // Max number of drives assuming primary/secondary, master/slave topology MAX_IDE_DRIVES = 16; procedure ReadPhysicalDriveInNTWithZeroRights (); var DriveNumber: Byte; HDDInfo: THDDInfo; begin HDDInfo := THDDInfo.Create(); try for DriveNumber := 0 to MAX_IDE_DRIVES - 1 do try HDDInfo.DriveNumber := DriveNumber; if HDDInfo.IsInfoAvailable then begin Writeln('VendorId: ', HDDInfo.VendorId); Writeln('ProductId: ', HDDInfo.ProductId); Writeln('ProductRevision: ', HDDInfo.ProductRevision); Writeln('SerialNumber: ', HDDInfo.SerialNumber); Writeln('SerialNumberInt: ', HDDInfo.SerialNumberInt); Writeln('SerialNumberText: ', HDDInfo.SerialNumberText); end; except on E: Exception do Writeln(Format('DriveNumber %d, %s: %s', [DriveNumber, E.ClassName, E.Message])); end; finally HDDInfo.Free; end; end; begin ReadPhysicalDriveInNTWithZeroRights; Write('Press <Enter>'); Readln; end.Unit from http://www.delphipraxis.net/564756-post28.html
// http://www.delphipraxis.net/564756-post28.html unit hddinfo; interface uses Windows, SysUtils, Classes; const IOCTL_STORAGE_QUERY_PROPERTY = $2D1400; type THDDInfo = class (TObject) private FDriveNumber: Byte; FFileHandle: Cardinal; FInfoAvailable: Boolean; FProductRevision: string; FProductId: string; FSerialNumber: string; FVendorId: string; procedure ReadInfo; procedure SetDriveNumber(const Value: Byte); public constructor Create; property DriveNumber: Byte read FDriveNumber write SetDriveNumber; property VendorId: string read FVendorId; property ProductId: string read FProductId; property ProductRevision: string read FProductRevision; property SerialNumber: string read FSerialNumber; function SerialNumberInt: Cardinal; function SerialNumberText: string; function IsInfoAvailable: Boolean; end; implementation type STORAGE_PROPERTY_QUERY = packed record PropertyId: DWORD; QueryType: DWORD; AdditionalParameters: array[0..3] of Byte; end; STORAGE_DEVICE_DESCRIPTOR = packed record Version: ULONG; Size: ULONG; DeviceType: Byte; DeviceTypeModifier: Byte; RemovableMedia: Boolean; CommandQueueing: Boolean; VendorIdOffset: ULONG; ProductIdOffset: ULONG; ProductRevisionOffset: ULONG; SerialNumberOffset: ULONG; STORAGE_BUS_TYPE: DWORD; RawPropertiesLength: ULONG; RawDeviceProperties: array[0..511] of Byte; end; function ByteToChar(const B: Byte): Char; begin Result := Chr(B + $30) end; function SerialNumberToCardinal (SerNum: String): Cardinal; begin HexToBin(PChar(SerNum), PChar(@Result), SizeOf(Cardinal)); end; function SerialNumberToString(SerNum: String): String; var I, StrLen: Integer; Pair: string; B: Byte; Ch: Char absolute B; begin Result := ''; StrLen := Length(SerNum); if Odd(StrLen) then Exit; I := 1; while I < StrLen do begin Pair := Copy (SerNum, I, 2); HexToBin(PChar(Pair), PChar(@B), 1); Result := Result + Chr(B); Inc(I, 2); end; I := 1; while I < Length(Result) do begin Ch := Result[I]; Result[I] := Result[I + 1]; Result[I + 1] := Ch; Inc(I, 2); end; end; constructor THddInfo.Create; begin inherited; SetDriveNumber(0); end; function THDDInfo.IsInfoAvailable: Boolean; begin Result := FInfoAvailable end; procedure THDDInfo.ReadInfo; type PCharArray = ^TCharArray; TCharArray = array[0..32767] of Char; var Returned: Cardinal; Status: LongBool; PropQuery: STORAGE_PROPERTY_QUERY; DeviceDescriptor: STORAGE_DEVICE_DESCRIPTOR; PCh: PChar; begin FInfoAvailable := False; FProductRevision := ''; FProductId := ''; FSerialNumber := ''; FVendorId := ''; try FFileHandle := CreateFile( PChar('\\.\PhysicalDrive' + ByteToChar(FDriveNumber)), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 ); if FFileHandle = INVALID_HANDLE_VALUE then RaiseLastOSError; ZeroMemory(@PropQuery, SizeOf(PropQuery)); ZeroMemory(@DeviceDescriptor, SizeOf(DeviceDescriptor)); DeviceDescriptor.Size := SizeOf(DeviceDescriptor); Status := DeviceIoControl( FFileHandle, IOCTL_STORAGE_QUERY_PROPERTY, @PropQuery, SizeOf(PropQuery), @DeviceDescriptor, DeviceDescriptor.Size, Returned, nil ); if not Status then RaiseLastOSError; if DeviceDescriptor.VendorIdOffset <> 0 then begin PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.VendorIdOffset]; FVendorId := PCh; end; if DeviceDescriptor.ProductIdOffset <> 0 then begin PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.ProductIdOffset]; FProductId := PCh; end; if DeviceDescriptor.ProductRevisionOffset <> 0 then begin PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.ProductRevisionOffset]; FProductRevision := PCh; end; if DeviceDescriptor.SerialNumberOffset <> 0 then begin PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.SerialNumberOffset]; FSerialNumber := PCh; end; FInfoAvailable := True; finally if FFileHandle <> INVALID_HANDLE_VALUE then CloseHandle(FFileHandle); end; end; function THDDInfo.SerialNumberInt: Cardinal; begin Result := 0; if ((IsInfoAvailable = True) and (FSerialNumber <> '')) then Result := SerialNumberToCardinal(FSerialNumber) end; function THDDInfo.SerialNumberText: string; begin Result := ''; if ((IsInfoAvailable = True) and (FSerialNumber <> '')) then Result := SerialNumberToString(FSerialNumber) end; procedure THDDInfo.SetDriveNumber(const Value: Byte); begin FDriveNumber := Value; ReadInfo; end; end.Edit: RAID configurations require special provisions.
For instance, I got a RAID system with multiple RAID 5 array; only the first one displays, and it does not show the drive serial numbers, but the serial number of the RAID array:
VendorId: AMCC ProductId: 9550SXU-16ML ProductRevision: 3.08 SerialNumber: 006508296D6A2A00DE82 SerialNumberInt: 688416000–jeroen
–jeroen
The Wiert Corner - irregular stream of stuff 