Contributor: DESCLIN JEAN
{
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 := 440ドルE;
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 := 440ドルE;
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.