home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / VTREE2.ZIP / VTREE2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-27  |  13.8 KB  |  428 lines
  1. PROGRAM ReadFile;
  2.  
  3. {$B-,D+,R-,S-,T+,V-}
  4. {
  5.    ┌────────────────────────────────────────────────────┐
  6.    │ USES AND GLOBAL VARIABLES & CONSTANTS              │
  7.    └────────────────────────────────────────────────────┘
  8. }
  9.  
  10. USES Crt, Dos;
  11.  
  12. CONST
  13.   NL = #13#10;
  14.  
  15. TYPE
  16.  
  17.   FPtr      = ^Dir_Rec;
  18.  
  19.   Dir_Rec   = record                             { Double pointer record    }
  20.     DirName : string[12];
  21.     DirNum  : integer;
  22.     Next    : Fptr;
  23.   END;
  24.  
  25.   Str_type  = string[65];
  26.  
  27. VAR
  28.  
  29.   Dir       : str_type;
  30.   Loop      : boolean;
  31.   Level     : integer;
  32.   Flag      : array[1..5] of string[20];
  33.   TreeOnly  : boolean;
  34.   FileTotal : longint;
  35.   ByteTotal : longint;
  36.   DirsTotal : longint;
  37.   TooDeep   : boolean;
  38.   ColorCnt  : byte;
  39.  
  40. {
  41.    ┌────────────────────────────────────────────────────┐
  42.    │ PROCEDURE Beepit                                   │
  43.    └────────────────────────────────────────────────────┘
  44. }
  45.  
  46. PROCEDURE Beepit;
  47.  
  48. BEGIN
  49.   SOUND (760);                                          { Beep the speaker }
  50.   DELAY (80);
  51.   NOSOUND;
  52. END;
  53.  
  54. {
  55.    ┌────────────────────────────────────────────────────┐
  56.    │ PROCEDURE Usage                                    │
  57.    └────────────────────────────────────────────────────┘
  58. }
  59.  
  60. PROCEDURE Usage;
  61.  
  62. BEGIN
  63.   BEEPIT;
  64.   WRITELN (
  65. 'Like the DOS TREE command, and similar to PC Magazine''s VTREE, but gives',NL,
  66. 'you a graphic representation of your disk hierarchical tree structure AND',NL,
  67. 'the number of files and total bytes in each tree node (optionally can be',NL,
  68. 'omitted).  Also allows starting at a particular subdirectory rather than',NL,
  69. 'displaying the entire drive''s tree structure.  Redirection of output and',NL,
  70. 'input is an option.  ',NL,
  71. '',NL,
  72. 'USAGE:     VTREE2 {path} {/t} {/r}',NL,
  73. '',NL,
  74. '/t or /T omits the number of files and total bytes information.',NL,
  75. '/r or /R activates redirection of input and output.',NL);
  76.   Halt;
  77. END;
  78.  
  79. {
  80.    ┌────────────────────────────────────────────────────┐
  81.    │ PROCEDURE Format_Num                               │
  82.    └────────────────────────────────────────────────────┘
  83. }
  84.  
  85. PROCEDURE Format_Num (Number : longint; VAR NumStr : string);
  86.  
  87. BEGIN
  88.   STR(Number,NumStr);
  89.  
  90.   IF (LENGTH (NumStr) > 6) THEN                  { Insert millions comma    }
  91.     INSERT (',',NumStr,(LENGTH(NumStr) - 5));
  92.  
  93.   IF (LENGTH (NumStr) > 3) THEN                  { Insert thousands comma   }
  94.     INSERT (',',NumStr,(LENGTH(NumStr) - 2));
  95.  
  96. END;
  97.  
  98. {
  99.    ┌────────────────────────────────────────────────────┐
  100.    │ PROCEDURE DisplayDir                               │
  101.    └────────────────────────────────────────────────────┘
  102. }
  103.  
  104. PROCEDURE DisplayDir (DirP : str_type; DirN : str_type; Levl : integer;
  105.                      NumSubsVar2 : integer; SubNumVar2 : integer;
  106.                      NumSubsVar3 : integer;
  107.                      NmbrFil : integer; FilLen : longint);
  108.  
  109. {NumSubsVar2 is the # of subdirs. in previous level;
  110.  NumSumsVar3 is the # of subdirs. in the current level.
  111.  DirN is the current subdir.; DirP is the previous path}
  112.  
  113. VAR
  114.   BegLine : string;
  115.   MidLine : string;
  116.   Blank   : string;
  117.   WrtStr  : string;
  118.   NumFil  : string;
  119.   FilByte : string;
  120.  
  121. BEGIN
  122.  
  123.   IF Levl > 5 THEN
  124.     BEGIN
  125.       BEEPIT;
  126.       TooDeep := True;
  127.       EXIT;
  128.     END;
  129.  
  130.   Blank   := '               ';                  { Init. variables          }
  131.   BegLine := '';
  132.   MidLine := ' ──────────────────';
  133.  
  134.   IF Levl = 0 THEN                               { Special handling for     }
  135.     IF Dir = '' THEN                             { initial (0) dir. level   }
  136.       IF NOT TreeOnly THEN
  137.         WrtStr := 'ROOT ──'
  138.       ELSE
  139.         WrtStr := 'ROOT'
  140.     ELSE
  141.       IF NOT TreeOnly THEN
  142.         WrtStr := DirP + ' ──'
  143.       ELSE
  144.         WrtStr := DirP
  145.   ELSE
  146.     BEGIN                                        { Level 1+ routines        }
  147.       IF SubNumVar2 = NumSubsVar2 THEN           { If last node in subtree, }
  148.         BEGIN                                    { use └─ symbol & set flag }
  149.           BegLine  := '└─';                      { padded with blanks       }
  150.           Flag[Levl] := ' ' + Blank;
  151.         END
  152.       ELSE                                       { Otherwise, use ├─ symbol }
  153.         BEGIN                                    { & set flag padded with   }
  154.           BegLine    := '├─';                    { blanks                   }
  155.           Flag[Levl] := '│' + Blank;
  156.         END;
  157.  
  158.       CASE Levl OF                               { Insert │ & blanks as     }
  159.          1: BegLine := BegLine;                  { needed, based on level   }
  160.          2: Begline := Flag[1] + BegLine;
  161.          3: Begline := Flag[1] + Flag[2] + BegLine;
  162.          4: Begline := Flag[1] + Flag[2] + Flag[3] + BegLine;
  163.          5: Begline := Flag[1] + Flag[2] + Flag[3] + Flag[4] + BegLine;
  164.       END; {end case}
  165.  
  166.       IF (NumSubsVar3 = 0) THEN                  { If cur. level has no     }
  167.         WrtStr := BegLine + DirN                 { subdirs., leave end blank}
  168.       ELSE
  169.         BEGIN
  170.           WrtStr := BegLine + DirN + COPY(Midline,1,(13-LENGTH(DirN)));
  171.           IF Levl < 5 THEN
  172.             IF TreeOnly = False THEN
  173.               WrtStr := WrtStr  + '─┬─'
  174.             ELSE
  175.               WrtStr := WrtStr + '─┐ '
  176.           ELSE                                   { If level 5, special      }
  177.             BEGIN                                { end to indicate more     }
  178.               DELETE (WrtStr,LENGTH(WrtStr),1);  { levels                   }
  179.               WrtStr := WrtStr + '»';
  180.             END;
  181.         END;
  182.     END;                                         { End level 1+ routines    }
  183.  
  184.   Format_Num (NmbrFil,NumFil);
  185.   Format_Num (FilLen,FilByte);
  186.  
  187.   IF ODD(ColorCnt) THEN
  188.     TextColor (3)
  189.   ELSE
  190.     TextColor (12);
  191.   INC (ColorCnt);
  192.  
  193.   IF ((Levl < 4) OR ((Levl = 4) AND (NumSubsVar3=0))) AND NOT TreeOnly THEN
  194.     WRITELN (WrtStr,'':(65 - LENGTH(WrtStr)),NumFil:3,FilByte:11)
  195.   ELSE
  196.     WRITELN (WrtStr);                            { Write # of files & bytes  }
  197.                                                  { only if it fits, else     }
  198. END;                                             { write only tree outline   }
  199.  
  200.  
  201. {
  202.    ┌────────────────────────────────────────────────────┐
  203.    │ PROCEDURE DisplayHeader                            │
  204.    └────────────────────────────────────────────────────┘
  205. }
  206.  
  207. PROCEDURE DisplayHeader;
  208.  
  209. BEGIN
  210.   WRITELN ('DIRECTORIES','':52,'FILES','      BYTES');
  211.   WRITELN ('═══════════════════════════════════════════════════════════════════════════════');
  212. END;
  213.  
  214. {
  215.    ┌────────────────────────────────────────────────────┐
  216.    │ PROCEDURE DisplayTally                             │
  217.    └────────────────────────────────────────────────────┘
  218. }
  219.  
  220. PROCEDURE DisplayTally;
  221.  
  222. VAR
  223.   AllFiles : string;
  224.   AllBytes : string;
  225.  
  226. BEGIN
  227.   Format_Num (ByteTotal, AllBytes);
  228.   Format_Num (FileTotal, AllFiles);
  229.   WRITELN('':63,'════════════════');
  230.   WRITELN('NUMBER OF DIRECTORIES: ', DirsTotal:3, '':29,
  231.           'TOTALS: ', AllFiles:5, AllBytes:11);
  232. END;
  233.  
  234. {
  235.    ┌────────────────────────────────────────────────────┐
  236.    │ PROCEDURE ReadFiles                                │
  237.    └────────────────────────────────────────────────────┘
  238. }
  239.  
  240. PROCEDURE ReadFiles (DirPrev : str_type; DirNext : str_type;
  241.                      SubNumVar1 : integer; NumSubsVar1 : integer);
  242.  
  243. VAR
  244.   FileInfo  : SearchRec;
  245.   FileBytes : longint;
  246.   NumFiles  : integer;
  247.   NumSubs   : integer;
  248.   Dir_Ptr   : FPtr;
  249.   CurPtr    : FPtr;
  250.   FirstPtr  : FPtr;
  251.  
  252. BEGIN
  253.   FileBytes := 0;
  254.   Numfiles  := 0;
  255.   NumSubs   := 0;
  256.   Dir_Ptr   := nil;
  257.   CurPtr    := nil;
  258.   FirstPtr  := nil;
  259.  
  260.   IF Loop THEN FindFirst (DirPrev + DirNext + '\*.*', AnyFile, FileInfo);
  261.   Loop      := False;                            { Get 1st file             }
  262.  
  263.   WHILE DosError = 0 DO                          { Loop until no more files }
  264.     BEGIN
  265.       IF (FileInfo.Name <> '.') AND (FileInfo.Name <> '..') THEN
  266.         BEGIN
  267.           IF (FileInfo.attr = directory) THEN    { If fetched file is dir., }
  268.             BEGIN                                { store a record with dir. }
  269.               NEW (Dir_Ptr);                     { name & occurence number, }
  270.               Dir_Ptr^.DirName  := FileInfo.name;{ and set links to         }
  271.               INC (NumSubs);                     { other records if any     }
  272.               Dir_Ptr^.DirNum   := NumSubs;
  273.               IF CurPtr = nil THEN
  274.                 BEGIN
  275.                   Dir_Ptr^.Next := nil;
  276.                   CurPtr        := Dir_Ptr;
  277.                   FirstPtr      := Dir_Ptr;
  278.                 END
  279.               ELSE
  280.                 BEGIN
  281.                   Dir_Ptr^.Next := nil;
  282.                   CurPtr^.Next  := Dir_Ptr;
  283.                   CurPtr        := Dir_Ptr;
  284.                  END;
  285.                END
  286.           ELSE
  287.             BEGIN                                { Tally # of bytes in file }
  288.               FileBytes := FileBytes + FileInfo.size;
  289.               INC (NumFiles);                    { Increment # of files,    }
  290.             END;                                 { excluding # of subdirs.  }
  291.         END;
  292.       FindNext (FileInfo);                       { Get next file            }
  293.     END;    {end WHILE}
  294.  
  295.     ByteTotal := ByteTotal + FileBytes;
  296.     FileTotal := FileTotal + Numfiles;
  297.     DirsTotal := DirsTotal + NumSubs;
  298.  
  299.     DisplayDir (DirPrev, DirNext, Level, NumSubsVar1, SubNumVar1, NumSubs,
  300.                 NumFiles, FileBytes);            { Pass info to & call      }
  301.     INC (Level);                                 { display routine, & inc.  }
  302.                                                  { level number             }
  303.  
  304.  
  305.     WHILE (FirstPtr <> nil) DO                   { If any subdirs., then    }
  306.       BEGIN                                      { recursively loop thru    }
  307.         Loop     := True;                        { ReadFiles proc. til done }
  308.         ReadFiles ((DirPrev + DirNext + '\'),FirstPtr^.DirName,
  309.                     FirstPtr^.DirNum, NumSubs);
  310.         FirstPtr := FirstPtr^.Next;
  311.       END;
  312.  
  313.  
  314.     DEC (Level);                                 { Decrement level when     }
  315.                                                  { finish a recursive loop  }
  316.                                                  { call to lower level of   }
  317.                                                  { subdir.                  }
  318. END;
  319.  
  320. {
  321.    ┌────────────────────────────────────────────────────┐
  322.    │ PROCEDURE Read_Parm                                │
  323.    └────────────────────────────────────────────────────┘
  324. }
  325.  
  326. PROCEDURE Read_Parm;
  327.  
  328. VAR
  329.   Cur_Dir : string;
  330.   Param   : string;
  331.   i       : integer;
  332.  
  333. BEGIN
  334.  
  335.   IF ParamCount > 3 THEN Usage;
  336.   Param := '';
  337.  
  338.   FOR i := 1 TO ParamCount DO                    { If either param. is a T, }
  339.     BEGIN                                        { set TreeOnly flag            }
  340.       Param := ParamStr(i);
  341.       IF Param[1] = '/' THEN
  342.         CASE Param[2] OF
  343.           't','T': BEGIN
  344.                      TreeOnly := True;
  345.                      IF ParamCount = 1 THEN EXIT;
  346.                    END;                          { Exit if only one param   }
  347.  
  348.           'r','R': BEGIN
  349.                      ASSIGN (Input,'');          { Override CRT unit, &     }
  350.                      RESET (Input);              { make input & output      }
  351.                      ASSIGN (Output,'');         { redirectable             }
  352.                      REWRITE (Output);
  353.                      IF ParamCount = 1 THEN EXIT;
  354.                    END;                          { Exit if only one param   }
  355.           '?'    : Usage;
  356.         ELSE
  357.           Usage;
  358.         END; {case}
  359.     END;
  360.  
  361.   GETDIR (0,Cur_Dir);                            { Save current dir         }
  362.   FOR i := 1 TO ParamCount DO
  363.     BEGIN
  364.       Param := ParamStr(i);                      { Set var to param. string }
  365.       IF (POS ('/',Param) = 0) THEN
  366.         BEGIN
  367.           Dir := Param;
  368. {$I-}     CHDIR (Dir);                           { Try to change to input   }
  369.           IF IOResult = 0 THEN                   { dir.; if it exists, go   }
  370.             BEGIN                                { back to orig. dir.       }
  371. {$I+}        CHDIR (Cur_Dir);
  372.              IF (POS ('\',Dir) = LENGTH (Dir)) THEN
  373.                DELETE (Dir,LENGTH(Dir),1);       { Change root symbol back  }
  374.              EXIT                                { to null, 'cause \ added  }
  375.             END                                  { in later                 }
  376.           ELSE
  377.             BEGIN
  378.               BEEPIT;
  379.               WRITELN ('No such directory -- please try again.');
  380.               HALT;
  381.             END;
  382.         END;
  383.     END;
  384.  
  385. END;
  386.  
  387. {
  388.    ┌────────────────────────────────────────────────────┐
  389.    │ MAIN PROGRAM                                       │
  390.    └────────────────────────────────────────────────────┘
  391. }
  392.  
  393. VAR
  394.  
  395.   Version : string;
  396.  
  397. BEGIN
  398.  
  399.   Version := 'Version 1.3, 6-27-88 -- Public Domain by John Land';
  400.                                                  { Sticks in EXE file      }
  401.  
  402.   Dir       := '';                               { Init. global vars.      }
  403.   Loop      := True;
  404.   Level     := 0;
  405.   TreeOnly  := False;
  406.   TooDeep   := False;
  407.   FileTotal := 0;
  408.   ByteTotal := 0;
  409.   DirsTotal := 1;                                { Always have a root dir. }
  410.   ColorCnt  := 1;
  411.  
  412.   ClrScr;
  413.  
  414.   IF ParamCount > 0 THEN Read_Parm;              { Deal with any params.   }
  415.  
  416.   IF NOT TreeOnly THEN DisplayHeader;
  417.  
  418.   ReadFiles (Dir,'',0,0);                        { Do main read routine    }
  419.  
  420.   IF NOT TreeOnly THEN DisplayTally;             { Display totals          }
  421.  
  422.   IF TooDeep THEN                                
  423.     WRITELN (NL,NL,'':22,'» CANNOT DISPLAY MORE THAN 5 LEVELS «',NL);
  424.                                                  { If ReadFiles detects >5 }
  425.                                                  { levels, TooDeep flag set}
  426.  
  427. END.
  428.