Hard Disk Drive

Is possible to find serial number of HDD from Delphi
If YES then please advice me
Thanks
tintiAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

syberniteCommented:
function DriveSerial( Drive: Char ): string;
var
  dwSerial, dwLength, dwFlags: DWord;
begin
  if GetVolumeInformation( PChar( Drive + ':\' ), nil, 0 , @dwSerial,
    dwLength, dwFlags, nil, 0 ) then
    Result := IntToHex( HiWord( dwSerial ), 4 ) + ':' + IntToHex( LoWord( dwSerial ), 4 );
end;

example ShowMessage( DriveSerial( 'C' ) );
alanjbrownCommented:
Yes you can get serial number.
Try this bit of code:-

function GetDiskVolSerialID(
  cDriveName : char ) : DWord;
var
  dwTemp1,
  dwTemp2 : DWord;
begin
  GetVolumeInformation(
    PChar( cDriveName + ':\' ),
    Nil,
    0,
    @Result,
    dwTemp2,
    dwTemp2,
    Nil,
    0
    );
end;


Good luck
Alan
DragonSlayerCommented:
this should get you the *real* serial number (the unique one that comes from the manufacturer, not the one that gets regenerated everytime you format your hard disk... the above examples using GetVolumeInformation doesn't get the manufacturer serial number):

unit HDD_Serial;
interface
uses Windows, SysUtils;
function GetHddSerial: String;
implementation
function GetIdeDiskSerialNumber: String;
type
TSrbIoControl = packed record
  HeaderLength : ULONG;
  Signature    : Array[0..7] of Char;
  Timeout      : ULONG;
  ControlCode  : ULONG;
  ReturnCode   : ULONG;
  Length       : ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;
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;
IDEREGS   = TIDERegs;
PIDERegs  = ^TIDERegs;
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;
SENDCMDINPARAMS   = TSendCmdInParams;
PSendCmdInParams  = ^TSendCmdInParams;
TIdSector = packed record
  wGenConfig                 : Word;
  wNumCyls                   : Word;
  wReserved                  : Word;
  wNumHeads                  : Word;
  wBytesPerTrack             : Word;
  wBytesPerSector            : Word;
  wSectorsPerTrack           : Word;
  wVendorUnique              : Array[0..2] of Word;
  sSerialNumber              : Array[0..19] of Char;
  wBufferType                : Word;
  wBufferSize                : Word;
  wECCSize                   : Word;
  sFirmwareRev               : Array[0..7] of Char;
  sModelNumber               : Array[0..39] of Char;
  wMoreVendorUnique          : Word;
  wDoubleWordIO              : Word;
  wCapabilities              : Word;
  wReserved1                 : Word;
  wPIOTiming                 : Word;
  wDMATiming                 : Word;
  wBS                        : Word;
  wNumCurrentCyls            : Word;
  wNumCurrentHeads           : Word;
  wNumCurrentSectorsPerTrack : Word;
  ulCurrentSectorCapacity    : ULONG;
  wMultSectorStuff           : Word;
  ulTotalAddressableSectors  : ULONG;
  wSingleWordDMA             : Word;
  wMultiWordDMA              : Word;
  bReserved                  : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;
const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE       = 512;
DFP_RECEIVE_DRIVE_DATA        = $0007c088;
IOCTL_SCSI_MINIPORT           = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY  = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer; // PSendCmdInParams;
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;
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;
begin
Result := '';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
  begin // Windows NT, Windows 2000
    // Get SCSI port handle
    hDevice := CreateFile( '\\.\Scsi0:', GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK',srbControl.Signature,8);
      srbControl.Timeout      := 2;
      srbControl.Length       := DataSize;
      srbControl.ControlCode  := IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData := PSendCmdInParams(PChar(@Buffer)+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
      with pInData^ do
      begin
        cBufferSize  := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do
        begin
          bFeaturesReg     := 0;
          bSectorCountReg  := 1;
          bSectorNumberReg := 1;
          bCylLowReg       := 0;
          bCylHighReg      := 0;
          bDriveHeadReg    := $A0;
          bCommandReg      := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
  end
else
  begin // Windows 95 OSR2, Windows 98
    hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
try
     pInData := PSendCmdInParams(@Buffer);
pOutData := PChar(@pInData^.bBuffer);
     with pInData^ do
     begin
       cBufferSize  := IDENTIFY_BUFFER_SIZE;
       bDriveNumber := 0;
       with irDriveRegs do
       begin
         bFeaturesReg     := 0;
         bSectorCountReg  := 1;
         bSectorNumberReg := 1;
         bCylLowReg       := 0;
         bCylHighReg      := 0;
         bDriveHeadReg    := $A0;
         bCommandReg      := IDE_ID_FUNCTION;
       end;
     end;
     if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, pInData, SizeOf(TSendCmdInParams)-1, pOutData, W9xBufferSize, cbBytesReturned, nil ) then Exit;
finally
      CloseHandle(hDevice);
end;
  end;
  with PIdSector(PChar(pOutData)+16)^ do
  begin
    ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
    SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
  end;
end;
function GetDeviceHandle( sDeviceName : String ) : THandle;
begin
 Result := CreateFile( PChar('\\.\'+sDeviceName), GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end;
function ScsiHddSerialNumber( DeviceHandle : THandle ) : String;
{$ALIGN ON}
type
 TScsiPassThrough = record
    Length             : Word;
    ScsiStatus         : Byte;
    PathId             : Byte;
    TargetId           : Byte;
    Lun                : Byte;
    CdbLength          : Byte;
    SenseInfoLength    : Byte;
    DataIn             : Byte;
    DataTransferLength : ULONG;
    TimeOutValue       : ULONG;
    DataBufferOffset   : DWORD;
    SenseInfoOffset    : ULONG;
    Cdb                : Array[0..15] of Byte;
 end;
 TScsiPassThroughWithBuffers = record
    spt : TScsiPassThrough;
    bSenseBuf : Array[0..31] of Byte;
    bDataBuf : Array[0..191] of Byte;
 end;
{ALIGN OFF}
var
 dwReturned : DWORD;
 len : DWORD;
 Buffer : Array[0..SizeOf(TScsiPassThroughWithBuffers)+SizeOf(TScsiPassThrough)-1] of Byte;
 sptwb : TScsiPassThroughWithBuffers absolute Buffer;
begin
 Result := '';
 FillChar(Buffer,SizeOf(Buffer),#0);
 with sptwb.spt do begin
    Length   := SizeOf(TScsiPassThrough);
    CdbLength := 6; // CDB6GENERIC_LENGTH
    SenseInfoLength := 24;
    DataIn := 1; // SCSI_IOCTL_DATA_IN
    DataTransferLength := 192;
    TimeOutValue := 2;
    DataBufferOffset := PChar(@sptwb.bDataBuf)-PChar(@sptwb);
    SenseInfoOffset := PChar(@sptwb.bSenseBuf)-PChar(@sptwb);
    Cdb[0] := $12; // OperationCode := SCSIOP_INQUIRY;
    Cdb[1] := $01; // Flags := CDB_INQUIRY_EVPD;  Vital product data
    Cdb[2] := $80; // PageCode            Unit serial number
    Cdb[4] := 192; // AllocationLength
 end;
 len := sptwb.spt.DataBufferOffset+sptwb.spt.DataTransferLength;
 if DeviceIoControl( DeviceHandle, $0004d004, @sptwb, SizeOf(TScsiPassThrough), @sptwb, len, dwReturned, nil ) and ((PChar(@sptwb.bDataBuf)+1)^=#$80) then
    SetString( Result, PChar(@sptwb.bDataBuf)+4, Ord((PChar(@sptwb.bDataBuf)+3)^) );
end;
function GetHddSerial: String;
var
 NumTry: Byte;
 FinalStr: String;
 hDevice: THandle;
 sDeviceName: String;
begin
 NumTry := 1;
 Repeat
    Case NumTry Of
       1:
          Begin
             FinalStr := Trim(GetIdeDiskSerialNumber);
          End;
       2:
          Begin
             sDeviceName := 'C:';
             hDevice := GetDeviceHandle(sDeviceName);
             If hDevice <> INVALID_HANDLE_VALUE Then Begin
                Try
                   FinalStr := Trim(ScsiHddSerialNumber(hDevice));
                Finally
                   CloseHandle(hDevice);
                End;
             End;
          End;
       3: Begin
             FinalStr := 'Error!';
          End;
    End;
    Inc(NumTry);
 Until (FinalStr <> '') Or (NumTry > 3);
 Result := FinalStr;
end;

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Rowby Goren Makes an Impact on Screen and Online

Learn about longtime user Rowby Goren and his great contributions to the site. We explore his method for posing questions that are likely to yield a solution, and take a look at how his career transformed from a Hollywood writer to a website entrepreneur.

robert_marquardtCommented:
DragonSlayer, is that selfwritten source?
If so would you donate it to Project Jedi? It would be a welcome addition to the Jedi Code Library.
DragonSlayerCommented:
Hi robert,

Umm... I would love to claim ownership, but alas the code isn't mine. Found it somewhere... quite a while ago... from one of the experts here in EE... I'll check it out and get back to you later.
DragonSlayerCommented:
ok Robert, original source, in C++ http://www.winsim.com/diskid32/diskid32.cpp

then translated by Alex Konshin mailto:alexk@mtgroup.ru on (30 jul 2000)
translated source: http://home.earthlink.net/~akonshin/files/IdeSN.zip

perhaps you would like to email him?
DragonSlayerCommented:
then modified by slavikn to include SCSI support http://www.delphipages.com/threads/thread.cfm?ID=72807&G=71130
robert_marquardtCommented:
Thanks, i asked slavikn for donation. Alex will follow if slavikn agrees.
akonshinCommented:
This is my own code and I did it in July 2000.
Actually the only thing that "invented" by me is using IOCTL_SCSI_MINIPORT for IDE disks that allow to get s/n without administrative privileges. Maybe it is also done in diskid32 at the same time but I doubt on it.
The latest version can be downloaded from my homepage
http://home.earthlink.net/~akonshin/index.htm
I strongly recommend to use IdeSN2 example rather than IdeSN.

http://www.delphipages.com/threads/thread.cfm?ID=72807&G=71130 is just combination of two my examples.

I think I tried to donate this code to JEDI a long time ago but nobody was intresting in it.
I you want to do it now - you welcome.
akonshinCommented:
My current email is akonshin@earthlink.net
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.