[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]
Program Vtree2;
{$B-,D+,R-,S-,V-}
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Uses and GLOBAL VarIABLES & ConstANTS ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Uses
Crt, Dos;
Const
NL = #13#10;
NonVLabel = ReadOnly + Hidden + SysFile + Directory + Archive;
Type
FPtr = ^Dir_Rec;
Dir_Rec = Record { Double Pointer Record }
DirName : String[12];
DirNum : Integer;
Next : Fptr;
end;
Str_Type = String[65];
Var
Version : String;
Dir : str_Type;
Loop : Boolean;
Level : Integer;
Flag : Array[1..5] of String[20];
TreeOnly : Boolean;
Filetotal : LongInt;
Bytetotal : LongInt;
Dirstotal : LongInt;
tooDeep : Boolean;
ColorCnt : Byte;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure Beepit ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure Beepit;
begin
Sound (760); { Beep the speaker }
Delay (80);
NoSound;
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure Usage ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure Usage;
begin
BEEPIT;
Write (NL,
'Like the Dos TREE command, and similar to PC Magazine''s VTREE, but gives',NL,
'you a Graphic representation of your disk hierarchical tree structure and',NL,
'the number of Files and total Bytes in each tree node (optionally can be',NL,
'omitted). Also allows starting at a particular subdirectory rather than',NL,
'displaying the entire drive''s tree structure. Redirection of output and',NL,
'input is an option.',NL,NL, 'USAGE: VTREE2 {path} {/t} {/r}',NL,NL,
'/t or /T omits the number of Files and total Bytes inFormation.',NL,
'/r or /R activates redirection of input and output.',NL,NL, Version);
Halt;
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Function Format ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Function Format (Num : LongInt) : String; {converts Integer to String}
{with commas inserted }
Var
NumStr : String[12];
Place : Byte;
begin
Place := 3;
STR (Num, NumStr);
Num := Length (NumStr); {re-use Num For Length value }
While Num > Place do {insert comma every 3rd place}
begin
inSERT (',',NumStr, Num - (Place -1));
inC (Place, 3);
end;
Format := NumStr;
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure DisplayDir ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure DisplayDir (DirP : str_Type; DirN : str_Type; Levl : Integer;
NumSubsVar2 : Integer; SubNumVar2 : Integer;
NumSubsVar3 : Integer;
NmbrFil : Integer; FilLen : LongInt);
{NumSubsVar2 is the # of subdirs. in previous level;
NumSumsVar3 is the # of subdirs. in the current level.
DirN is the current subdir.; DirP is the previous path}
Const
LevelMax = 5;
Var
BegLine : String;
MidLine : String;
Blank : String;
WrtStr : String;
begin
if Levl > 5 then
begin
BEEPIT;
tooDeep := True;
Exit;
end;
Blank := ' '; { Init. Variables }
BegLine := '';
MidLine := ' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ';
if Levl = 0 then { Special handling For }
if Dir = '' then { initial (0) dir. level }
if not TreeOnly then
WrtStr := 'ROOT ÄÄ'
else
WrtStr := 'ROOT'
else
if not TreeOnly then
WrtStr := DirP + ' ÄÄ'
else
WrtStr := DirP
else
begin { Level 1+ routines }
if SubNumVar2 = NumSubsVar2 then { if last node in subtree, }
begin { use ÀÄ symbol & set flag }
BegLine := 'ÀÄ'; { padded With blanks }
Flag[Levl] := ' ' + Blank;
end
else { otherwise, use ÃÄ symbol }
begin { & set flag padded With }
BegLine := 'ÃÄ'; { blanks }
Flag[Levl] := '³' + Blank;
end;
Case Levl of { Insert ³ & blanks as }
1: BegLine := BegLine; { needed, based on level }
2: Begline := Flag[1] + BegLine;
3: Begline := Flag[1] + Flag[2] + BegLine;
4: Begline := Flag[1] + Flag[2] + Flag[3] + BegLine;
5: Begline := Flag[1] + Flag[2] + Flag[3] + Flag[4] + BegLine;
end; {end Case}
if (NumSubsVar3 = 0) then { if cur. level has no }
WrtStr := BegLine + DirN { subdirs., leave end blank}
else
begin
WrtStr := BegLine + DirN + COPY(Midline,1,(13-Length(DirN)));
if Levl < LevelMax then
WrtStr := WrtStr + 'Ä¿'
else { if level 5, special }
begin { end to indicate more }
DELETE (WrtStr,Length(WrtStr),1); { levels }
WrtStr := WrtStr + '¯';
end;
end;
end; { end level 1+ routines }
if ODD(ColorCnt) then
TextColor (3)
else
TextColor (11);
inC (ColorCnt);
if ((Levl < 4) or ((Levl = 4) and (NumSubsVar3=0))) and not TreeOnly then
WriteLn (WrtStr,'':(65-Length(WrtStr)), Format(NmbrFil):3,
Format(FilLen):11)
else
WriteLn (WrtStr); { Write # of Files & Bytes }
{ only if it fits, else }
end; { Write only tree outline }
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure DisplayHeader ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure DisplayHeader;
begin
WriteLn ('DIRECtoRIES','':52,'FileS',' ByteS');
WriteLn ('ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure DisplayTally ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure DisplayTally;
begin
WriteLn('':63,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
WriteLn('NUMBER of DIRECtoRIES: ', Dirstotal:3, '':29,
'toTALS: ', Format (Filetotal):5, Format (Bytetotal):11);
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure ReadFiles ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure ReadFiles (DirPrev : str_Type; DirNext : str_Type;
SubNumVar1 : Integer; NumSubsVar1 : Integer);
Var
FileInfo : SearchRec;
FileBytes : LongInt;
NumFiles : Integer;
NumSubs : Integer;
Dir_Ptr : FPtr;
CurPtr : FPtr;
FirstPtr : FPtr;
begin
FileBytes := 0;
NumFiles := 0;
NumSubs := 0;
Dir_Ptr := nil;
CurPtr := nil;
FirstPtr := nil;
if Loop then
FindFirst (DirPrev + DirNext + '\*.*', NonVLabel, FileInfo);
Loop := False; { Get 1st File }
While DosError = 0 do { Loop Until no more Files }
begin
if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') then
begin
if (FileInfo.attr = directory) then { if fetched File is dir., }
begin { store a Record With dir. }
NEW (Dir_Ptr); { name & occurence number, }
Dir_Ptr^.DirName := FileInfo.name;{ and set links to }
inC (NumSubs); { other Records if any }
Dir_Ptr^.DirNum := NumSubs;
if CurPtr = nil then
begin
Dir_Ptr^.Next := nil;
CurPtr := Dir_Ptr;
FirstPtr := Dir_Ptr;
end
else
begin
Dir_Ptr^.Next := nil;
CurPtr^.Next := Dir_Ptr;
CurPtr := Dir_Ptr;
end;
end
else
begin { Tally # of Bytes in File }
FileBytes := FileBytes + FileInfo.size;
inC (NumFiles); { Increment # of Files, }
end; { excluding # of subdirs. }
end;
FindNext (FileInfo); { Get next File }
end; {end While}
Bytetotal := Bytetotal + FileBytes;
Filetotal := Filetotal + NumFiles;
Dirstotal := Dirstotal + NumSubs;
DisplayDir (DirPrev, DirNext, Level, NumSubsVar1, SubNumVar1, NumSubs,
NumFiles, FileBytes); { Pass info to & call }
inC (Level); { display routine, & inc. }
{ level number }
While (FirstPtr <> nil) do { if any subdirs., then }
begin { recursively loop thru }
Loop := True; { ReadFiles proc. til done }
ReadFiles ((DirPrev + DirNext + '\'),FirstPtr^.DirName,
FirstPtr^.DirNum, NumSubs);
FirstPtr := FirstPtr^.Next;
end;
DEC (Level); { Decrement level when }
{ finish a recursive loop }
{ call to lower level of }
{ subdir. }
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ Procedure Read_Parm ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
Procedure Read_Parm;
Var
Cur_Dir : String;
Param : String;
i : Integer;
begin
if ParamCount > 3 then
Usage;
Param := '';
For i := 1 to ParamCount do { if either param. is a T, }
begin { set TreeOnly flag }
Param := ParamStr(i);
if Param[1] = '/' then
Case Param[2] of
't','T': begin
TreeOnly := True;
if ParamCount = 1 then
Exit;
end; { Exit if only one param }
'r','R': begin
ASSIGN (Input,''); { Override Crt Unit, & }
RESET (Input); { make input & output }
ASSIGN (Output,''); { redirectable }
REWrite (Output);
if ParamCount = 1 then
Exit;
end; { Exit if only one param }
'?' : Usage;
else
Usage;
end; {Case}
end;
GETDIR (0,Cur_Dir); { Save current dir }
For i := 1 to ParamCount do
begin
Param := ParamStr(i); { Set Var to param. String }
if (POS ('/',Param) = 0) then
begin
Dir := Param;
{$I-} CHDIR (Dir); { Try to change to input }
if Ioresult = 0 then { dir.; if it exists, go }
begin { back to orig. dir. }
{$I+} CHDIR (Cur_Dir);
if (POS ('\',Dir) = Length (Dir)) then
DELETE (Dir,Length(Dir),1); { Change root symbol back }
Exit; { to null, 'cause \ added }
end { in later }
else
begin
BEEPIT;
WriteLn ('No such directory -- please try again.');
HALT;
end;
end;
end;
end;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ MAin Program ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}
begin
Version := 'Version 1.6, 7-16-90 -- Public Domain by John Land';
{ Sticks in EXE File }
Dir := ''; { Init. global Vars. }
Loop := True;
Level := 0;
TreeOnly := False;
tooDeep := False;
Filetotal := 0;
Bytetotal := 0;
Dirstotal := 1; { Always have a root dir. }
ColorCnt := 1;
ClrScr;
if ParamCount > 0 then
Read_Parm; { Deal With any params. }
if not TreeOnly then
DisplayHeader;
ReadFiles (Dir,'',0,0); { do main read routine }
TextColor(Yellow);
if not TreeOnly then
DisplayTally; { Display totals }
if tooDeep then
WriteLn (NL,NL,'':22,'¯ CANnot DISPLAY MorE THAN 5 LEVELS ®',NL);
{ if ReadFiles detects >5 }
{ levels, tooDeep flag set}
end.
[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]