Solved

Get hdd serialnr.

Posted on 1998-12-15
7
203 Views
Last Modified: 2010-04-04
How do i do to read the serialnr on the harddrive?
The number you get when you run dir in dos.
Do i have to wright my own code or is it somewere in D4 Proffesional
0
Comment
Question by:samone
  • 4
  • 2
7 Comments
 
LVL 3

Accepted Solution

by:
williams2 earned 50 total points
ID: 1351194
To read it from DOS you'll have to it by this way:

 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;

end.



____________________________________________________________

If you have to read it from windows, you better use this:

You will need to make a new application and provide a button, then insert an 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 4

Expert Comment

by:dwwang
ID: 1351195
Opps, need that many code? :)

function GetSerialIDEx:string;
var
   VolumeSerialNumber : DWORD;
   MaximumComponentLength : DWORD;
   FileSystemFlags : DWORD;
   SerialNumber : string;
begin
     GetVolumeInformation('C:\', nil, 0, @VolumeSerialNumber, MaximumComponentLength, FileSystemFlags, nil, 0);
     SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) +
                     '-' +
                     IntToHex(LoWord(VolumeSerialNumber), 4);
     Result:=SerialNumber;
end;

0
 
LVL 3

Expert Comment

by:williams2
ID: 1351196
Maybe not, but it works! ..I have tested the examples before writing the cut'n'paste-to-unit1-code. :-)

Regards,
Williams
0
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.

 
LVL 3

Expert Comment

by:williams2
ID: 1351197
..You should also remark, that the last example using the getVolumeInformation is not supported in all Delphi versions, therefore it's in the above case explicitely extracted from kernel32.dll. :-)
0
 
LVL 4

Expert Comment

by:dwwang
ID: 1351198
Thanks for your remarks :-)

My code is copied from my running programm, also I see exactly that the question includes "D4 professional", and then paste my comment.

Regards,
Wang
0
 

Author Comment

by:samone
ID: 1351199
Exactly what I needed thanks!
0
 
LVL 3

Expert Comment

by:williams2
ID: 1351200
Wang:
You are right about the version, but I was not sure if was supported in D4 as I found it so buggy that I just uninstalled the ****, but anyway he won't have to include the whole ShellAPI :-)

samone:
I'm glad that this works fine for you, I'll be there anytime.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…

825 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