Solved

HDD Serial No.

Posted on 1998-12-06
12
933 Views
Last Modified: 2012-08-14
How do I get the Local Hard Disk Drive Serial Number  Using Delphi 1.0?
0
Comment
Question by:nigelbogle
  • 5
  • 4
  • 2
  • +1
12 Comments
 
LVL 17

Expert Comment

by:inthe
ID: 1349588
procedure TForm1.Button1Click(Sender: TObject);
 var
   SerialNum : dword;
   a, b : dword;
   Buffer  : array [0..255] of char;
 begin
   if GetVolumeInformation('c:\', Buffer,SizeOf buffer) ,@SerialNum,> a, b, nil, 0) then
  Label1.Caption := IntToStr (SerialNum);
 end;
0
 

Author Comment

by:nigelbogle
ID: 1349589
This ONLY works with a program compiled with Delphi 2 and UP!  NOT delphi 1.0

Thanks anyway....
0
 
LVL 4

Expert Comment

by:jeurk
ID: 1349590
Hi,
Here you get two solutions, hopefully one of them is working.
Let me know.

------------------------------------------
 unit Procs;

 interface

 uses
   Forms, DB, DBGrids, DBTables, Graphics, Classes, Dialogs;

 Type
      TRWBlock = Record
         rwSpecFunc: Byte;
         rwHead: Word;
         rwCylinder: Word;
         rwFirstSector: Word;
         rwSectors: Word;
         rwBufPtr: Pointer;
      End;

      TBootSector = Record
          bsJump: Array[0..2] of Byte;
          bsOemName: Array[0..7] of Char;
          bsBytesPerSec: Word;
          bsSecPerClust: Byte;
          bsResSectors: Word;
          bsFATs: Byte;
          bsRootDirEnts: Word;
          bsSectors: Word;
          bsMedia: Byte;
          bsFATSecs: Word;
          bsSecPerTrack: Word;
          bsHeads: Word;
          bsHiddensecs: Longint;
          bsHugeSectors: LongInt;
          bsDriveNumber: Byte;
          bsReserved: Byte;
          bsBootsignature: Byte;
          bsVolumeID: Array[0..3] of Byte;
          bsVolumeLabel: Array[0..10] of Char;
          bsFileSysType: Array[0..7] of Char;
      End;

 Const RWBlock: TRWBlock = (rwSpecFunc: 0;
                            rwHead: 0;
                            rwCylinder: 0;
                            rwfirstSector: 0;
                            rwSectors: 1;
                            rwBufPtr: nil);

 Function ReadBootSector(Drive: Word; Var BootSector: TBootsector): Boolean;

 implementation

 Uses MsgForm;

 Function ReadBootSector(Drive: Word; Var BootSector: TBootsector): Boolean;
 Var Buffer: Array[0..1023] of Byte; Status: Word;
 Begin
    RWBlock.rwBufPtr := addr(Buffer);
    asm
         mov         bx, Drive
         mov         ch, 08h
         mov         cl, 61h
         mov         dx, seg RWBlock
         mov         ds, dx
         mov         dx, offset RWBlock
         mov         ax, 440dh
         int         21h
         jc          @Error_handler
         jmp         @ok
      @Error_handler:
         mov         Status, ax
         jmp         @exit
      @ok:
         mov         status, 0
      @exit:
    End;
    ReadBootSector := Status = 0;
    If Status = 0 Then Move(Buffer, BootSector, SizeOf(TBootSector));
 End;

 end.

{ -------------  ANOTHER WAY TO DO IT -------------------- }

Type
  InfoBuffer = RECORD
    InfoLevel : WORD;
    Serial : DWord;
    VolLabel : ARRAY [0..10]OF CHAR;
    FileSystem : ARRAY [0..7]OF CHAR;
End;

Function TFMain.GetDiskSerNo(Drive : Byte) : String;
Const
  HexDigits : ARRAY [0..15]OF CHAR = '0123456789ABCDEF';
Var
  IB   : InfoBuffer;
  N    : WORD;

  Function SerialStr (L : LONGINT) : String;
  Var
    Temp : String;
  Begin
    {Temp [0] := #9; }
    Temp [1] := HexDigits [L SHR 28];
    Temp [2] := HexDigits [ (L SHR 24) AND $F];
    Temp [3] := HexDigits [ (L SHR 20) AND $F];
    Temp [4] := HexDigits [ (L SHR 16) AND $F];
    Temp [5] := '-';
    Temp [6] := HexDigits [ (L SHR 12) AND $F];
    Temp [7] := HexDigits [ (L SHR 8) AND $F];
    Temp [8] := HexDigits [ (L SHR 4) AND $F];
    Temp [9] := HexDigits [L AND $F];
    SerialStr := Temp;
  End;

  Function GetSerial (DiskNum : BYTE; VAR I : InfoBuffer) : WORD; assembler;
    asm
      MOV AH, 69h
      MOV AL, 00h
      MOV BL, DiskNum
      PUSH DS
      LDS DX, I  {error here "Operand Size Mismatch I"}
      INT 21h
      POP DS
      JC @Bad
      XOR AX, AX
      @Bad :
    end;

Begin
  N := GetSerial (Drive, IB);
  If N = 0 then
    Result := SerialStr (IB.Serial)
  else
    Result := 'Error Reading Disk';
End;

This is an extract of the swag library and was done by H;B. Lanier
0
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 

Author Comment

by:nigelbogle
ID: 1349591
Cheers jeurk... I'll give it a go.  

Thanks for your swift reply.. I really appreciate it..

0
 
LVL 3

Accepted Solution

by:
williams2 earned 100 total points
ID: 1349592
You should try implementing this on a form with a button. Here you will get everything using the standard kernel32 dll:

You will need to make a event OnClick procedure to the button before pasting this into unit1:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  kernel32  = 'kernel32.dll';

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
  TVolumeInfo = record
     Name               : String;
     SerialNumber       : DWORD;
     MaxComponentLength : DWORD;
     FileSystemFlags    : DWORD;
     FileSystemName     : String;
  end; // TVolumeInfo

function GetVolumeInformationA(lpRootPathName: PAnsiChar;
  lpVolumeNameBuffer: PAnsiChar; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
  var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
  lpFileSystemNameBuffer: PAnsiChar; nFileSystemNameSize: DWORD): BOOL; stdcall;
external 'kernel32.dll' name 'GetVolumeInformationA';
function GetVolumeInformationW(lpRootPathName: PWideChar;
  lpVolumeNameBuffer: PWideChar; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
  var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
  lpFileSystemNameBuffer: PWideChar; nFileSystemNameSize: DWORD): BOOL; stdcall;
external 'kernel32.dll' name 'GetVolumeInformationW';
function GetVolumeInformation(lpRootPathName: PChar;
  lpVolumeNameBuffer: PChar; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD;
  var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
  lpFileSystemNameBuffer: PChar; nFileSystemNameSize: DWORD): BOOL; stdcall;
external 'kernel32.dll' name 'GetVolumeInformationA';

var
  Form1: TForm1;

implementation

{$R *.DFM}

function MyGetVolumeInformation( const Drive : Char ) : TVolumeInfo;
var
   lpRootPathName           : PChar; // address of root directory of the file system
   lpVolumeNameBuffer       : PChar; // address of name of the volume
   nVolumeNameSize          : DWORD; // length of lpVolumeNameBuffer
   lpVolumeSerialNumber     : DWORD; // address of volume serial number
   lpMaximumComponentLength : DWORD; // address of system's maximum filename length
   lpFileSystemFlags        : DWORD; // address of file system flags
   lpFileSystemNameBuffer   : PChar; // address of name of file system
   nFileSystemNameSize      : DWORD; // length of lpFileSystemNameBuffer
begin
   GetMem( lpVolumeNameBuffer, MAX_PATH + 1 );
   GetMem( lpFileSystemNameBuffer, MAX_PATH + 1 );
   try
      nVolumeNameSize     := MAX_PATH + 1;
      nFileSystemNameSize := MAX_PATH + 1;

      lpRootPathName := PChar( Drive + ':\' );
      if GetVolumeInformation( lpRootPathName,
                               lpVolumeNameBuffer,
                               nVolumeNameSize,
                               @lpVolumeSerialNumber,
                               lpMaximumComponentLength,
                               lpFileSystemFlags,
                               lpFileSystemNameBuffer,
                               nFileSystemNameSize ) then
      begin
         with Result do
         begin
            Name               := lpVolumeNameBuffer;
            SerialNumber       := lpVolumeSerialNumber;
            MaxComponentLength := lpMaximumComponentLength;
            FileSystemFlags    := lpFileSystemFlags;
            FileSystemName     := lpFileSystemNameBuffer;
         end; // with Result
      end // if
      else
      begin
         with Result do
         begin
            Name               := '';
            SerialNumber       := -1;
            MaxComponentLength := -1;
            FileSystemFlags    := -1;
            FileSystemName     := '';
         end; // with Result
      end; // else
   finally
      FreeMem( lpVolumeNameBuffer );
      FreeMem( lpFileSystemNameBuffer );
   end; // try
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   VolumeInfo : TVolumeInfo;
   flags      : String;
begin
   VolumeInfo := MyGetVolumeInformation( 'C' );
   with VolumeInfo do
   begin
      if (FileSystemFlags and FS_CASE_IS_PRESERVED) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10#9'FS_CASE_IS_PRESERVED'
            else
               flags := 'FS_CASE_IS_PRESERVED';

         if (FileSystemFlags and FS_CASE_SENSITIVE) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10#9'FS_CASE_SENSITIVE'
            else
               flags := 'FS_CASE_SENSITIVE';

         if (FileSystemFlags and FS_UNICODE_STORED_ON_DISK) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10#9'FS_UNICODE_STORED_ON_DISK'
            else
               flags := 'FS_UNICODE_STORED_ON_DISK';

         if (FileSystemFlags and FS_PERSISTENT_ACLS) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10#9'FS_PERSISTENT_ACLS'
            else
               flags := 'FS_PERSISTENT_ACLS';

         if (FileSystemFlags and FS_FILE_COMPRESSION) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10#9'FS_FILE_COMPRESSION'
            else
               flags := 'FS_FILE_COMPRESSION';

         if (FileSystemFlags and FS_VOL_IS_COMPRESSED) <> 0 then
            if Length( flags ) <> 0 then
               flags := flags + #13#10#9'FS_VOL_IS_COMPRESSED'
            else
               flags := 'FS_VOL_IS_COMPRESSED';

      ShowMessage( 'Volume Information For Drive C'#13#10#13#10 +
                   'Name:'#9 + Name + #13#10 +
                   'Serial Number:'#9 + Copy( IntToHex( SerialNumber, 0 ), 1, 4 ) + '-' + Copy( IntToHex( SerialNumber, 0 ), 5, 4 )+ #13#10 +
                   'Max Component Length:'#9 + IntToStr( MaxComponentLength ) + #13#10 +
                   'File System Flags:'#13#10#9 + Flags + #13#10 +
                   'File System:'#9 + FileSystemName );
   end; // with VolumeInfo
end;
end.


Cheers,
Williams
0
 
LVL 3

Expert Comment

by:williams2
ID: 1349593
You might prefer jeurks reply on this thing, it seems like B.Lanier really did know a thing or two about serialnumbers. But I won't rely on such implementations when coding for future versions or backwardscompatiblity.

This is the way Delphi (And windows) is getting the information.. But if you plan on using it for DOS, my answer is not worth anything.

Cheers,
Williams
0
 
LVL 4

Expert Comment

by:jeurk
ID: 1349594
I do agree with williams2.
No future compatibilty. But it was an proposal for delphi 1,
delphi 2 and up are doing things like you sayd ;)

0
 
LVL 3

Expert Comment

by:williams2
ID: 1349595
Hey Jeurk.

Do you have any documented ressources on that asm thing? It seems pretty nice, that someone did this the hard asm way!
Does this thing work in dos?

Regards,
Williams
0
 
LVL 4

Expert Comment

by:jeurk
ID: 1349596
I have not tested it, but it will work under dos for sure.
I think that it was ported from a previous dos turbo pascal program.
as you can see it's a dos INT 21 call function 69
the other sample is calling  INT 21 call function 61
that's why this will not work under NT, because dos is not ther (and for other reasons)

You can find documentation on that in every asm book,
after that it's only a matter of calling this in delphi ;)
what do you need to know ?

CU
0
 
LVL 3

Expert Comment

by:williams2
ID: 1349597
I could use the URL, where you got the ressources on this subject. It may state other things like handling network in dos etc. That I would find extremely interesting.

Regards,
Williams
0
 
LVL 4

Expert Comment

by:jeurk
ID: 1349598
Sorry but I found it in the swag archive. Here is the adress to get the whole thing.
I think that there might be some help for you.
http://www.gdsoft.com/swag/downloads.html
NOVELL/LANTASTIC network snipets
You need the reader by the way.

0
 
LVL 3

Expert Comment

by:williams2
ID: 1349599
Yep, I know the swag's.

Thanx, I didn't think of looking there.

Regards,
Williams
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

813 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now