[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3212
  • Last Modified:

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
0
TRADY_BUKY
Asked:
TRADY_BUKY
5 Solutions
 
mikelittlewoodCommented:
0
 
Mohammed NasmanSoftware 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
 
TheRealLokiSenior 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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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
 
esoftbgCommented:
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
 
CodedKCommented:
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

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now