Board index » delphi » hard drive serial no.

hard drive serial no.

does anyone have any idea how to get at it from within BP7?

Thanks,
Ben.

 

Re:hard drive serial no.


In article <31B7170E.4...@tne.net.au>, Ben Dixon  <h...@tne.net.au> wrote:
:does anyone have any idea how to get at it from within BP7?

-From: ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip Frequently Asked TP Questions
-Subject: Volume Serial Number

83. *****
 Q: How can I read a disk's Volume Serial Number?

 A: The Volume Serial Number for disks was introduced in MS-DOS
version 4.0. Here is an example code
  uses Dos;
  {}
  (* Convert a longint to a hexadecimal string *)
  function LHEXFN (decimal : longint) : string;
  const hexDigit : array [0..15] of char = '0123456789ABCDEF';
  var i         : byte;
      hexString : string;
  begin
    FillChar (hexString, SizeOf(hexString), ' ');
    hexString[0] := chr(8);
    for i := 0 to 7 do
      hexString[8-i] := HexDigit[(decimal shr (4*i)) and $0F];
    lhexfn := hexString;
  end;  (* lhexfn *)
  {}
  (* Get disk serial number. Requires MS-DOS 4.0+.
     Else, or on an error, returns an empty string.
     The default drive can be pointed to by using '0' *)
  function GETSERFN (drive : char) : string;
  type diskInfoRecordType =
    record
      infoLevel      : word;                   { zero }
      serialNumber   : longint;                { DWORD actually }
      volumeLabel    : array [1..11] of char;  { NO NAME if none present }
      filesystemType : array [1..8] of char;   { FAT12 or FAT16 }
    end;
  var regs     : registers;
      diskInfo : diskInfoRecordType;
      serial   : string;
  begin
    getserfn := '';
    if swap(DosVersion) < $0400 then exit;
    FillChar (regs, SizeOf(regs), 0);
    drive := UpCase (drive);
    if drive <> '0' then if (drive < 'A') or (drive > 'Z') then exit;
    regs.ah := $69;             { Interrrupt 21 function $69 }
    regs.al := $00;             { subfunction: get serial number }
    if drive <> '0' then
      regs.bl := ord(drive) - ord('A') + 1
      else regs.bl := 0;
    regs.ds := Seg(diskInfo);   { the diskInfo address: }
    regs.dx := Ofs(diskInfo);   { its segment and offset }
    Intr ($21, regs);
    if (regs.flags and FCarry) <> 0 then exit;  { CF is set on error }
    serial := LHEXFN (diskInfo.serialNumber);
    getserfn := Copy (serial, 1, 4) + '-' + Copy (serial, 5, 4);
  end;  (* getserfn *)
  {}
  begin
    writeln ('C: ', GETSERFN('C'));
  end.

 A2: The second alternative has been modified from a posting by
Robert B. Clark rcl...@su1.in.net. I have also utilized INTERRUP.E
from Ralf Brown's listing of interrupt calls
 ftp://garbo.uwasa.fi/pc/programming/inter49b.zip
  {}
  uses Dos;
  function GETSERFN2 (drive : char): longint;
  var ParBlock : array [0..24] of char;  { IOCTL parameter block Table 0785 }
      regs     : registers;
      sernum   : longint;
  begin
    FillChar (ParBlock, SizeOf(ParBlock), 0);
    FillChar (regs, SizeOf(regs), 0);
    regs.ax := $440D;     { IOCTL - generic block device request }
    if drive <> '0' then  { '0' points to the default drive }
      regs.bl := ord(UpCase(drive)) - ord('A') + 1  { drive as byte }
      else regs.bl := 0;
    regs.ch := $08;       { block device IOCTL category code: disk drive }
    regs.cl := $66;       { IOCTL minor code: get volume serial number }
    regs.ds := Seg(ParBlock);   { Parameter block segment address }
    regs.dx := Ofs(ParBlock);   { Parameter block offset }
    MsDos (regs);         { Call interrupt $21 }
    if regs.Flags and FCarry = 0 then
      sernum := word(ord(ParBlock[4]) + ord(ParBlock[5]) shl 8) * 65536 +
                word (ord(ParBlock[2]) + ord(ParBlock[3]) shl 8)
    else sernum := 0;
    getserfn2 := sernum;
  end;  (* getsetfn2 *)
  {}
  begin
    writeln ('C: ', LHEXFN(GETSERFN2('0')));
  end.

 A3: Setting a disk's serial number, instead of just reading it, is
more complicated and will not be covered here. If you need it, the
routine without source code is available (for floppies only for
security reasons) as
  "SETSER Set floppy's serial number (MsDos 4.0+)"
in TSUNTK.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip

--------------------------------------------------------------------

   All the best, Timo

....................................................................
Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi archives  193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa
t...@uwasa.fi http://uwasa.fi/~ts BBS 961-3170972; FIN-65101,  Finland

Other Threads