GETTING UNIQUE DISK SERIAL NUMBER WITH DELPHI

I've seen various ways how to get the unique disk serial number (a format independent ID) proposed by experts, but none of these said solutions was in Delphi (but C++, Assembly and VB). Is there any way to explore the unique values of a computer HD with a straight forward Delphi 7 (or compatible) version
TRADY_BUKYAsked:
Who is Participating?
 
Mohammed NasmanConnect With a Mentor Software DeveloperCommented:
look at IdeSN2 and ScsiSN for extract the phicsal serial no, not volume no
http://home.earthlink.net/~akonshin/delphi_components.htm

also look at geobul answer here
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20490497.html
0
 
TheRealLokiConnect With a Mentor Senior DeveloperCommented:
uses
  SysUtils, Dialogs, Windows;

var
  SerialNum : pdword;
  a, b : dword;
  Buffer  : array [0..255] of char;
begin
  if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer),
                          SerialNum, a, b, nil, 0) then
    ShowMessage (IntToHex(SerialNum^, 8))
  else
    ShowMessage ('- unknown -');
end;
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
esoftbgCommented:
download an example from:
page:        http://www.geocities.com/esoftbg/
  link:        Q_21410655.zip        GETTING UNIQUE DISK SERIAL NUMBER WITH DELPHI

It works fine under Windows 2000 and Windows XP (It is not tested under Windows 2003).
0
 
esoftbgConnect With a Mentor Commented:
Here is the code:

unit Unit_Q_21410655;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, DBT, StdCtrls, CheckLst;

const
      IDE_ID_FUNCTION            = $EC; // Returns ID sector for ATA.
      CAP_IDE_ID_FUNCTION        = 1;   // ATAPI ID command supported
      IDENTIFY_BUFFER_SIZE       = 512;
      DFP_RECEIVE_DRIVE_DATA     = $0007c088;

type
  TForm1 = class(TForm)
      spb_Get_HDD_SN: TSpeedButton;
      Memo: TMemo;
      ChkListBox: TCheckListBox;
      procedure FormCreate(Sender: TObject);
      procedure spb_Get_HDD_SNClick(Sender: TObject);
    private   { Private declarations }
      Separator:string;
    public    { Public declarations }
      function  Physical_SN(Id: Integer): Int64;
  end;

      USHORT = Word;
  TIdBuffer    = array [0..IDENTIFY_BUFFER_SIZE-1] of Byte;
      TGetVersionOutParams = packed record
            bVersion      : BYTE;                 // Binary driver version.
            bRevision     : BYTE;                 // Binary driver revision.
            bReserved     : BYTE;                 // Not used.
            bIDEDeviceMap : BYTE;                 // Bit map of IDE devices.
            fCapabilities : DWORD;                // Bit mask of driver capabilities.
            dwReserved    : Array[0..3] of DWORD; // For future use.
      end;

      TIdSector = packed record
            wGenConfig                 : USHORT;
            wNumCyls                   : USHORT;
            wReserved                  : USHORT;
            wNumHeads                  : USHORT;
            wBytesPerTrack             : USHORT;
            wBytesPerSector            : USHORT;
            wSectorsPerTrack           : USHORT;
            wVendorUnique              : Array[0..2] of USHORT;
            sSerialNumber              : Array[0..19] of CHAR;
            wBufferType                : USHORT;
            wBufferSize                : USHORT;
            wECCSize                   : USHORT;
            sFirmwareRev               : Array[0..7] of CHAR;
            sModelNumber               : Array[0..39] of CHAR;
            wMoreVendorUnique          : USHORT;
            wDoubleWordIO              : USHORT;
            wCapabilities              : USHORT;
            wReserved1                 : USHORT;
            wPIOTiming                 : USHORT;
            wDMATiming                 : USHORT;
            wBS                        : USHORT;
            wNumCurrentCyls            : USHORT;
            wNumCurrentHeads           : USHORT;
            wNumCurrentSectorsPerTrack : USHORT;
            ulCurrentSectorCapacity    : ULONG;
            wMultSectorStuff           : USHORT;
            ulTotalAddressableSectors  : ULONG;
            wSingleWordDMA             : USHORT;
            wMultiWordDMA              : USHORT;
            bReserved                  : Array[0..127] of BYTE;
      end;

      TDriverStatus = packed record
            bDriverError : Byte;                 // Error code from driver, or 0 if no error.
            bIDEStatus   : Byte;                 // Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.
            bReserved    : Array[0..1] of Byte;  // Reserved for future expansion.
            dwReserved   : Array[0..1] of DWORD; // Reserved for future expansion.
      end;

      TSendCmdOutParams = packed record
            cBufferSize  : DWORD;               // Size of bBuffer in bytes
            DriverStatus : TDriverStatus;       // Driver status structure.
            bBuffer      : Array[0..0] of BYTE; // Buffer of arbitrary length in which to store the data read from the drive.
      end;

      TIDERegs = packed record
            bFeaturesReg     : BYTE; // Used for specifying SMART "commands".
            bSectorCountReg  : BYTE; // IDE sector count register
            bSectorNumberReg : BYTE; // IDE sector number register
            bCylLowReg       : BYTE; // IDE low order cylinder value
            bCylHighReg      : BYTE; // IDE high order cylinder value
            bDriveHeadReg    : BYTE; // IDE drive/head register
            bCommandReg      : BYTE; // Actual IDE command.
            bReserved        : BYTE; // reserved for future use.  Must be zero.
      end;

      TSendCmdInParams = packed record
            cBufferSize  : DWORD;                // Buffer size in bytes
            irDriveRegs  : TIDERegs;             // Structure with drive register values.
            bDriveNumber : BYTE;                 // Physical drive number to send command to (0,1,2,3).
            bReserved    : Array[0..2] of Byte;  // Reserved for future expansion.
            dwReserved   : Array[0..3] of DWORD; // For future use.
            bBuffer      : Array[0..0] of Byte;  // Input buffer.
      end;

var
  Form1: TForm1;

var
  aIdBuffer: TIdBuffer;
  Id_Sector: TIdSector absolute aIdBuffer;
function  DirectIdentify(I: DWORD): Boolean;

implementation

{$R *.dfm}

var
  OSVersionInfo: TOSVersionInfo;

procedure TForm1.FormCreate(Sender: TObject);
var
  I:      Integer;
begin
  Separator := '................................................................';
  for I := 0 to 3 do
    ChkListBox.Checked[I] := True;
end;

function GetPhysicalDriveHandle(DriveNum: Byte; DesireAccess: ACCESS_MASK): THandle;
var
  S:     string;
begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  if OSVersionInfo.dwPlatformId=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
  begin
    Str(DriveNum,s); // avoid SysUtils
    Result := CreateFile( PChar('\\.\PhysicalDrive'+S), DesireAccess, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
  end
  else // Windows 95 OSR2, Windows 98
    Result := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
  {$ifdef debug}
  if Result=INVALID_HANDLE_VALUE then
    OutputDebugString(PChar('Error on CreateFile: '+SysErrorMessage(GetLastError)));
  {$endif}
end;

function SmartIdentifyDirect( hDevice : THandle; bDriveNum : Byte; bIDCmd : Byte; var IdSector : TIdSector; var IdSectorSize : LongInt ) : BOOL;
const
  BufferSize = SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1;
var
  SCIP:        TSendCmdInParams;
             Buffer : Array [0..BufferSize-1] of Byte;
             SCOP : TSendCmdOutParams absolute Buffer;
             dwBytesReturned : DWORD;
begin
  FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
  FillChar(Buffer,BufferSize,#0);
  dwBytesReturned := 0;
  IdSectorSize := 0;
  // Set up data structures for IDENTIFY command.
  with SCIP do
  begin
    cBufferSize  := IDENTIFY_BUFFER_SIZE;
    bDriveNumber := bDriveNum;
    with irDriveRegs do
    begin
      bFeaturesReg     := 0;
      bSectorCountReg  := 1;
      bSectorNumberReg := 1;
      bCylLowReg       := 0;
      bCylHighReg      := 0;
      bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
      bCommandReg      := bIDCmd;      // The command can either be IDE identify or ATAPI identify.
    end;
  end;
  Result := DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, @SCIP, SizeOf(TSendCmdInParams)-1, @SCOP, BufferSize, dwBytesReturned, nil );
  if Result then
  begin
    IdSectorSize := dwBytesReturned-SizeOf(TSendCmdOutParams)+1;
    if IdSectorSize<=0 then IdSectorSize := 0 else System.Move(SCOP.bBuffer,IdSector,IdSectorSize);
  end;
end;

function  DirectIdentify(I: DWORD): Boolean;
var
  B:               Boolean;
  hDevice:         THandle;
  nIdSectorSize:   LongInt;
begin
  B := False;
  FillChar(aIdBuffer, SizeOf(aIdBuffer), #0);
  try
    hDevice := GetPhysicalDriveHandle(I, GENERIC_READ or GENERIC_WRITE);
    try
      {$ifdef debug}
      OutputDebugString(PChar('GetPhysicalDriveHandle return '+IntToHex(hDevice,8)));
      {$endif}
      if (hDevice<>INVALID_HANDLE_VALUE) then
      try
        B := SmartIdentifyDirect(hDevice, 0, IDE_ID_FUNCTION, Id_Sector, nIdSectorSize);
      finally
        {$ifdef debug}
        OutputDebugString('PrintIdSectorInfo end');
        {$endif}
      end;
    finally
      Result := B;
      CloseHandle(hDevice);
    end;
  except
    Result := False;
  end;
end;

function  Hex_To_Dec(S: string): Int64;
var
  C:      Char;
  J:      Integer;
  II:     Int64;
  IH:     Int64;
begin
  IH := 0;
  try
    II := 1;
    while (S<>'') do
    begin
      C := S[Length(S)];
      if (C in ['0'..'9']) then
        J := StrToInt(C)
      else
        J := Ord(C) - 55;
      IH := IH + II * J;
      Delete(S,Length(S),1);
      II := II * 16;
    end;
  finally
    Result := IH;
  end;
end;

procedure ChangeByteOrder( var Data; Size : Integer );
var
  ptr:    PChar;
  i:      Integer;
  c:      Char;
begin
  ptr := @Data;
  for i := 0 to (Size shr 1)-1 do
  begin
    c := ptr^;
    ptr^ := (ptr+1)^;
    (ptr+1)^ := c;
    Inc(ptr,2);
  end;
end;

function  TForm1.Physical_SN(Id: Integer): Int64;
type
  TacOutBuffer  =  array[0..40] of Char;
var
  I:               Integer;
  IH:              Int64;
  acOutBuffer:     TacOutBuffer;
  T:               string;
begin
  IH := 0;
  try
    DirectIdentify(Id);
    with Id_Sector do
    begin
      ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
      acOutBuffer[SizeOf(sSerialNumber)] := #0;
      StrLCopy(acOutBuffer, sSerialNumber, SizeOf(sSerialNumber));
      I := 0;
      T := '';
      while (acOutBuffer[I] in [#32..#127]) do
      begin
        T := T + acOutBuffer[I];
        Inc(I);
      end;
      T := Trim(T);
      Memo.Lines.Add(Char(Id+67) + ':');
      Memo.Lines.Add('Hex. Serial num:' + T);
      IH := Hex_To_Dec(T);
      Memo.Lines.Add('Dec. Serial num:' + IntToStr(IH));
      Memo.Lines.Add(Separator);
    end;
  finally
    Result := IH;
  end;
end;

procedure TForm1.spb_Get_HDD_SNClick(Sender: TObject);
var
  I:      Integer;
  W:      Word;
begin
  Memo.Clear;
  Memo.Lines.Add(Separator);
  for I := 0 to ChkListBox.Items.Count-1 do
  begin
    if ChkListBox.Checked[I] then
    begin
      W := Ord(ChkListBox.Items[I][1]) - 67;
      Physical_SN(W);
    end;
  end;
  {
  Physical_SN(0); // C:
  Physical_SN(1); // D:
  Physical_SN(2); // E:
  }
end;

end.
0
 
CodedKConnect With a Mentor Commented:
function GetVolSN(Volumn:String):string;
var
   sVolName, sFName: Array[0..20] of Char;
   dwVolSN, dwMaxFNameLen, dwFlag: DWORD;
begin
  result:=' Nothing Found !';
  if GetVolumeInformation(PChar(Volumn), sVolName, 20,
@dwVolSN,dwMaxFNameLen, dwFlag, sFName, 20) then
    result := IntToHex(dwVolSN, 8);
end;

------------------------------------------------------------------------
Usage:
GetVolSN(ComboBoxEx1.Text);  // ComboBox
or
GetVolSN(Edit1.Text); // Edit control
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.