delphi – in Delphi7, How can I retrieve hard disk unique serial number? – Stack Overflow

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