Solved

HDD Serial No.

Posted on 1998-12-06
12
927 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
 

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
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

708 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