home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
UTILS1
/
FSP111.ZIP
/
FSP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-24
|
7KB
|
212 lines
PROGRAM FSP;
{------------------------------------------------------------------------------
REVISION HISTORY
v1.00 : 1993/07/14. First public release. DDA
v1.01 : 1993/12/26. Now discards data from FIRST CD-ROM drive. DDA
v1.02 : 1994/01/20. Now only reports valid local (inc. RAM) drives,
C through Z. Remote, SUBST, and CD drives ignored. DDA
v1.10 : 1994/01/23. Added volume label info. Edward Dombek (73727,162)
v1.11 : 1994/01/24. Integrated various previous suggestions above. DDA
------------------------------------------------------------------------------}
USES Crt, Dos; {Crt for colors, Dos for DiskSize/Free.}
CONST
ProgData = 'FSP (Free SPace), v1.11- DOS Multiple Hard Disk Space Utilization Utility.';
ProgDat2 = 'FREE software! Copyright: 94/01/24 by David Daniel Anderson - Reign Ware.';
ProgDat3 = 'DRIVE ALLOCATED FREE SPACE TOTAL SPACE FREE % LABEL';
VAR
TS,TF,TU : LongInt; {integer of Total space Size/Free/Used}
{maximum disk size of LongInt: 2 147 483 647 }
FUNCTION Comma(i : LongInt) : String; {Used in WriteDriveInfo & WriteTotalInfo}
VAR w : String[14]; {Insert commas to break up number string.}
c : ShortInt;
BEGIN
Str(i,w);
c := (Length(w) - 3);
WHILE c > 0 DO
BEGIN
Insert(',',w,c+1);
c := c - 3;
END;
Comma := w;
END;
FUNCTION LeadingZero(w : Word) : String; {Called by WriteDTInf to write time.}
VAR s : String;
BEGIN
Str(w:0,s);
IF Length(s) = 1 THEN
s := '0' + s;
LeadingZero := s;
END;
PROCEDURE WriteDTInf; {Called by WriteHeader to write Date & Time.}
CONST
Mon : Array [1..12] of String[9] =
('January','February','March','April','May','June','July',
'August','September','October','November','December');
VAR
Year,Month,Day, dow,
Hour,Min,Sec, hund : Word;
i : ShortInt;
DStr,
YStr,
DateStr : String[66];
BEGIN
GetDate(Year,Month,Day,dow);
GetTime(Hour,Min,Sec,hund);
Str(Day,DStr);
Str(Year,YStr);
DateStr := Mon[Month] + ' ' + DStr + ', ' + YStr;
WHILE ( (Length (DateStr)) < 66) DO
DateStr := DateStr + ' ' ;
WriteLn(DateStr,
LeadingZero(Hour),':',
LeadingZero(Min),':',
LeadingZero(Sec));
END;
PROCEDURE WriteHeader; {Called by main.}
CONST
hyphens = '--------------------------------------------------------------------------';
VAR i : ShortInt;
BEGIN
TextBackGround(Blue); TextColor(White);
WriteLn(ProgData); {...a constant...}
WriteLn(ProgDat2); {...a constant...}
TextBackGround(Black); TextColor(LightBlue);
WriteDTInf;
TextColor(LightCyan);
WriteLn(ProgDat3); {...a constant...}
WriteLn(hyphens);
END;
PROCEDURE WritePercent(TFree,TSpace : LongInt); {Called by WriteDriveInfo }
{ & WriteTotalInfo. }
VAR SPF : String[8]; {String of Percentage Free}
PF : Integer; {integer of Percentage Free, initially 10 x %}
BEGIN
PF := Round(1000 * (TFree / TSpace)); {Using 1000 to give tenths of %}
Str(PF,SPF);
Insert('.',SPF,(Length(SPF))); {Insert period for tenths of a percent.}
TextColor(White); Write(SPF:8,'%');
END;
PROCEDURE WriteInColor(u,f,s : LongInt);
BEGIN
TextColor(LightRed); Write(Comma(U):14);
TextColor(LightGreen); Write(Comma(F):14);
TextColor(Magenta); Write(Comma(S):15);
END;
PROCEDURE WriteDriveInfo(DriveCounter:byte); {Called by main.}
VAR DS,DF,DU : LongInt; {integer of Disk space Size/Free/Used}
Fblock : SearchRec;
VolName : String;
BEGIN
DS := DiskSize(DriveCounter);
DF := DiskFree(DriveCounter);
DU := DS - DF;
TS := TS + DS; TF := TF + DF; TU := TU + DU;
TextColor(Yellow); Write(Chr(DriveCounter+64),' --> ');
WriteInColor(DU,DF,DS);
WritePercent(DF,DS); {...a procedure...}
{!}
FindFirst(Chr(DriveCounter+64)+':\*.*',$8,Fblock); {...Volume Label?...}
If DosError <> 0 then
VolName := 'none'
else
begin
VolName := Fblock.Name;
if (pos('.',VolName) <> 0) then
delete (VolName,pos('.',VolName),1); { remove period if present }
{ delete (VolName,9,1); } {...Remove period from 9th position...}
end;
TextColor(Yellow); WriteLn(' ',VolName);
END;
PROCEDURE WriteTotalInfo; {Called by main.}
CONST
eqline = '==========================================================================';
VAR i : ShortInt;
BEGIN
TextColor(LightGray);
WriteLn (eqline);
TextColor(Yellow); Write('TOTALS=');
WriteInColor(TU,TF,TS);
WritePercent(TF,TS); {...a procedure...}
WriteLn;
END;
{=============================================================================}
Function IsDriveValid(cDrive: Char; Var bLocal, bSUBST: Boolean): Boolean;
{ ** SWAG snippet
Parameters: cDrive is the drive letter, 'A' to 'Z', that's about
to be checked. if not in this range, the Function will return False.
Returns: Function returns True if the given drive is valid, else
False (!). bLocal is set if drive is local, bSUBST if drive is
substituted. if Function returns False, the Booleans are undefined.
}
Var
rCPU: Dos.Registers;
begin
{ --- Call Dos and process returns --- }
if not (UpCase(cDrive) in ['A'..'Z']) then { --- letter OK?--- }
IsDriveValid := False
else
begin
{ --- Valid letter, set up For the Dos-call --- }
rCPU.bx := ord(UpCase(cDrive))-ord('A')+1;
rCPU.ax := $4409;
{ --- Call the Dos IOCTL (InOutConTroL)-Functions --- }
Intr($21, rCPU);
if (rCPU.ax and FCarry) = FCarry then
IsDriveValid := False
else
begin { --- drive is valid, check status --- }
IsDriveValid := True;
bLocal := ((rCPU.dx and $1000) = $0000);
if bLocal then
bSUBST := ((rCPU.dx and $8000) = $8000)
else
bSUBST := False;
end;
end;
end; { IsDriveValid }
{=============================================================================}
Var
cCurChar : Char ; { loop counter, drive }
bLocal,
bSUBST : Boolean ; { drive local/remote?; SUBSTed or not? }
BEGIN
TS := 0; TF := 0; TU := 0;
IF ParamStr(1) = '' THEN ClrScr;{Clear screen unless ANY parameter given.}
WriteHeader; {...a procedure...}
For cCurChar := 'C' to 'Z' do
if IsDriveValid(cCurChar, bLocal, bSUBST) then
if (blocal and (not bSUBST)) then
WriteDriveInfo(ord(cCurChar)-64);
WriteTotalInfo; {...a procedure...}
NormVideo;
END.