Category : Pascal Source Code
Archive   : VTREE2.ZIP
Filename : VTREE2.PAS

PROGRAM ReadFile;

{$B-,D+,R-,S-,T+,V-}
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ USES AND GLOBAL VARIABLES & CONSTANTS ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

USES Crt,Dos;

TYPE

FPtr = ^Dir_Rec;

Dir_Rec = record { Double pointer record }
DirName : string;
DirNum : integer;
Next : Fptr;
Prev : Fptr;
END;

Str_type = string[65];

VAR

Dir : string;
Loop : boolean;
Level : integer;
Flag : array[1..5] of string;
Tree : boolean;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Beepit ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Beepit;

BEGIN
SOUND (760); { Beep the speaker }
DELAY (80);
NOSOUND;
ClrScr;
END;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE Format_Num ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

PROCEDURE Format_Num (Number : longint; VAR NumStr : string);

BEGIN
STR(Number,NumStr);

IF (LENGTH (NumStr) > 6) THEN { Insert millions comma }
INSERT (',',NumStr,(LENGTH(NumStr) - 5));

IF (LENGTH (NumStr) > 3) THEN { Insert thousands comma }
INSERT (',',NumStr,(LENGTH(NumStr) - 2));

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}

VAR
BegLine : string;
MidLine : string;
Blank : string;
WrtStr : string;
NumFil : string;
FilByte : string;

BEGIN

IF Levl > 5 THEN
BEGIN
BEEPIT;
WRITELN;
WRITELN ('CANNOT DISPLAY MORE THAN 5 LEVELS.');
WRITELN;
EXIT;
END;

Blank := ' '; { Init. variables }
BegLine := '';
MidLine := ' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ';

IF Levl = 0 THEN { Special handling for }
IF Dir = '' THEN { initial (0) dir. level }
IF Tree = False THEN
WrtStr := 'ROOT ÄÄ'
ELSE
WrtStr := 'ROOT'
ELSE
IF Tree = False 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
IF Tree = False THEN
WrtStr := BegLine + DirN + COPY(Midline,1,(13-LENGTH(DirN))) + 'ÄÂÄ'
ELSE
WrtStr := BegLine + DirN + COPY(Midline,1,(13-LENGTH(DirN))) + 'Ä¿ ';
END; { End level 1+ routines }

Format_Num(NmbrFil,NumFil);
Format_Num(FilLen,FilByte);

IF ((Levl < 4) OR ((Levl = 4) AND (NumSubsVar3=0))) AND (Tree = False) THEN
WRITELN (WrtStr,'':(65 - LENGTH(WrtStr)),NumFil:3,FilByte:11)
ELSE
WRITELN (WrtStr); { Write # of files & bytes }
{ only if it fits, else }
END; { write only tree outline }

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ 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 + '\*.*', AnyFile, 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^.Prev := nil;
Dir_Ptr^.Next := nil;
CurPtr := Dir_Ptr;
FirstPtr := Dir_Ptr;
END
ELSE
BEGIN
Dir_Ptr^.Prev := CurPtr;
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}


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
BEGIN
BEEPIT;
WRITELN ('Too many parameters -- only starting path and/or "tree"');
WRITELN ('option (/t or /T) and/or "redirect" option (/r or /R)');
WRITELN ('allowed.');
HALT;
END;

Param := '';

FOR i := 1 TO ParamCount DO { If either param. is a T, }
BEGIN { set Tree flag }
Param := ParamStr(i);
IF Param[1] = '/' THEN
CASE Param[2] OF
't','T': BEGIN
Tree := 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 }
ELSE
BEGIN
BEEPIT;
WRITELN ('Invalid parameter -- only /t, /T, /r, or / R allowed.');
HALT;
END;
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 ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

VAR

Version : string;

BEGIN

Version := 'Ver. 1.0, 4-3-88'; { Sticks in EXE file }

Dir := ''; { Init. global vars. }
Loop := True;
Level := 0;
Tree := False;

ClrScr;

IF ParamCount > 0 THEN Read_Parm; { Deal with any params. }

ReadFiles (Dir,'',0,0); { Do main read routine }

END.