{
 A few days ago, Bryan Ellis (gt6918b@prism.gatech.edu) mentioned
 that he had trouble with the DiskFree function of TP.
 I did'nt see any answer on this subject posted to the list.
 Since I also feel that this function yields misleading
 results to the unaware, and available clusters on the disk
 are also a requisite for full information, I post below a
 small program to document another way to implement the
 Diskfree function.

That part of the following code referring to the identification
of ramdisks has already been posted on info-pascal@brl.mil; I have
added the procedure DiskEval to display info about the drive, because
I have found that many users are not aware of the notion of 'slack'
which is the consequence of the use of clusters.
}

{$N+,E+}

program diskall;

{
displays all drives (except network drives :-() actually in use by
the system, mentions when one is mapped to another one (such as B: to
A: in systems with only one floppy drive), tries to identify RAM
disks but fails to do so with 'Stacked' disks and possibly also with
'Doublespaced' drives: I refrained from trying the latter on _MY_
stacked HD! The program further shows the available space on the disk
chosen by the user among available drives.
From what I have gathered in books and on the net, there is no fail-
safe way of identifying RAM disks. If somebody among the readers of
this should know otherwise, I would be grateful if he could email me
the solution at:
 desclinj@ulb.ac.be  (internet; Dr Jean Desclin)
                     (Lab. of Histology, Fac. of Medicine)
                     (Brussels Free University (U.L.B.) Belgium)
}
uses Dos,CRT;

Type String25 = String[25];

var
    ver               : byte;
    DrvStr            : String;
    DrvLet            : char;
    Count             : shortint;
    car               : char;

Procedure Pinsert(var chain: string25);
{Eases reading long numbers by inserting decimal points(commas)}
Const pdec : string[1] = ',';
var nv     :    string25;
    loc    :    integer;
begin
  nv := chain;
  if length(chain) > 3 then
    begin
       loc := length(chain) - 2;
       Move(Nv[loc],Nv[succ(loc)],succ(Length(Nv))-loc);
       Move(Pdec[1],Nv[loc],1);
       inc(Nv[0]);
       while (pos(pdec[1],Nv) > 4) do
           begin
              chain := Nv;
              loc := pos(pdec[1],Nv) - 3;
              Move(Nv[loc],Nv[succ(loc)],succ(length(Nv)) - loc);
              Move(pdec[1],Nv[loc],1);
              inc(Nv[0])
           end;
    end;
  chain := nv
end;

procedure GetDrives1(var DS: string);{for DOS >= 3.x but <4.0       }
{Adapted from Michael Tischer's Turbo Pascal 6 System Programming,  }
{Abacus 1991, ISBN 1-55755-124-3                                    }
type DPBPTR    = ^DPB;           { pointer to a DOS Parameter Block }
     DPBPTRPTR = ^DPBPTR;           { pointer to a pointer to a DPB }
     DPB       = record       { recreation of a DOS Parameter Block }
                    Code  : byte;       { drive code (0=A, 1=B etc. }
                    dummy1: array [1..$07] of byte;{irrelevant bytes}
                    FatNb : byte; {Number of File Allocation Tables }
                    dummy2: array [9..$17] of byte;{irrelevant bytes}
                    Next  : DPBPTR;           { pointer to next DPB }
                 end;                    { xxxx:FFFF marks last DPB }

var Regs    : Registers;              { register for interrupt call }
    CurrDpbP : DPBPTR;                  { pointer to DPBs in memory }

begin
   {-- get pointer to first DPB ------------------------------------}

  Regs.AH := $52;{ function $52 returns ptr to 'List of Lists'      }
  MsDos( Regs );{ that's an UNDOCUMENTED DOS function !             }
  CurrDpbP := DPBPTRPTR( ptr( Regs.ES, Regs.BX ) )^;
  {-- follow the chain of DPBs--------------------------------------}
  repeat
    begin
     write(chr(ord('A')+CurrDpbP^.Code ),{ display device code  }
              ': ' );
     DS := DS + chr(ord('A')+CurrDpbP^.Code);
     if CurrDpbP^.Code > 0 then
       begin
         Regs.AX := $440E;
         Regs.BL := CurrDpbP^.Code;
         MsDos(Regs);
         if Regs.AL <> 0 then
           writeln(' is actually mapped to ',
                    chr(ord('A')+pred(CurrDpbP^.Code)))
       end;

     if ((CurrDpbP^.FatNb > 0) AND (CurrDpbP^.FatNb < 2)) then
        writeln(' (RAMDISK)');
    end;
     CurrDpbP := CurrDpbP^.Next;   { set pointer to next DPB        }
  until ( Ofs( CurrDpbP^ ) = $FFFF );  { until last DPB is reached }
 writeln
 end;

procedure GetDrives2(var DS: string);{for DOS versions>=4.0         }
{almost the same as GetDrives1, but for dummy2 which is one byte    }
{longer in DOS 4+                                                   }
type DPBPTR    = ^DPB;           { pointer to a DOS Parameter Block }
     DPBPTRPTR = ^DPBPTR;           { pointer to a pointer to a DPB }
     DPB       = record       { recreation of a DOS Parameter Block }
                  Code   : byte;      { drive code ( 0=A, 1=B etc.  }
                  dummy1 : array [1..$07] of byte;{ irrelevant bytes}
                  FatNb  : byte;{ Number of File Allocation Tables  }
                  dummy2 : array [9..$18] of byte;{ irrelevant bytes}
                  Next   : DPBPTR;          { pointer to next DPB   }
                 end;                    { xxxx:FFFF marks last DPB }

var Regs    : Registers;              { register for interrupt call }
    CurrDpbP : DPBPTR;                  { pointer to DPBs in memory }

begin
   {-- get pointer to first DPB-------------------------------------}

  Regs.AH := $52;{ function $52 returns ptr to Dos 'List of lists'  }
   MsDos( Regs );{ that's an UNDOCUMENTED DOS function !            }
 CurrDpbP := DPBPTRPTR( ptr( Regs.ES, Regs.BX ) )^;

  {-- follow the chain of DPBs -------------------------------------}

  repeat
    begin
     write( chr( ord('A') + CurrDpbP^.Code ),{ display device code  }
              ': ');
     DS := DS + chr(ord('A')+CurrDpbP^.Code);
     if CurrDpbP^.Code > 0 then
       begin
         Regs.AX := $440E;
         Regs.BL := CurrDpbP^.Code;
         MsDos(Regs);
         if Regs.AL <> 0 then
           writeln(' is actually mapped to ',
                    chr(ord('A')+pred(CurrDpbP^.Code)))
       end;
     if ((CurrDpbP^.FatNb > 0) AND (CurrDpbP^.FatNb < 2)) then
        writeln(' (RAMDISK)');
    end;
     CurrDpbP := CurrDpbP^.Next;   { set pointer to next DPB        }
   until ( Ofs( CurrDpbP^ ) = $FFFF );  { until last DPB is reached }
   writeln
 end;

Procedure DiskEval;
{computes statistics of disk chosen by user}

var Reg : registers;
    Drive             : char;
    column,row        : shortint;
    SectorsPerCluster : Word;
    AvailClusters     : Word;
    BytesPerSector    : Word;
    TotalClusters     : Word;
    BytesAvail,Clut   : longint;
    Kilos             : extended;
    ByAl              : string25;
    TotClut           : string25;
    OneClut           : string25;
    AvailClut         : string25;
begin
    write('');
    column  := whereX;
    row     := whereY;
    repeat
       gotoXY(column,row);
       write('Which drive to read from? ',' ',chr(8));
       read(Drive);
       Drive := UpCase(Drive);
    until (pos(Drive,DrvStr) <> 0);
    writeln;
    with Reg do begin
         DL := ord(Drive) - 64;
         AH := $36;
         Intr($21,Reg);
         SectorsPerCluster  := AX;
         AvailClusters      := BX;
         BytesPerSector     := CX;
         TotalClusters      := DX
    end;
    BytesAvail := longint(BytesPerSector) * longint(SectorsPerCluster)
                  * longint(AvailClusters);
    Kilos := BytesAvail/1024;
    clut := longint(SectorsPerCluster)*longint(BytesPerSector);
    Str(BytesAvail,Byal);
    Pinsert(Byal);
    Str(AvailClusters,AvailClut);
    Pinsert(AvailClut);
    Str(Clut,OneClut);
    Pinsert(OneClut);
    Str(TotalClusters,TotClut);
    Pinsert(Totclut);
    clrscr;
    if SectorsPerCluster <> 65535 then
      begin
        write('For drive ');
        HighVideo;
        write(Drive);
        LowVideo;
        writeln(':');
        writeln('Sectors per cluster: ',SectorsPerCluster);
        writeln('Bytes per sector: ',BytesPerSector);
        writeln('Total clusters: ',TotClut);
        writeln('Available clusters: ',AvailClut);
        write('(One cluster = ',oneclut,' bytes: the smallest');
        writeln(' allocatable space!)');
        write('A TOTAL of ',ByAl,' BYTES are AVAILABLE (',Kilos:6:3);
        writeln(' K)') {previous line split for display: length <73 }
      end
    else writeln('There is no diskette in drive ',Drive,': !')
end;

begin
   car := #0;
   repeat
      DrvStr := '';
      DrvLet := #0;
      clrscr;
      ver := Lo(DosVersion);
      writeln('Installed logical drives are : '#13#10);
      if ver < 4 then
        GetDrives1(DrvStr)
      else
        GetDrives2(DrvStr);
      DiskEval;
      writeln;
      write('type ''Y'' to continue, any other key to exit.');
      car := upcase(readkey);
   until (car <> 'Y')
end.