[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]

    PROGRAM YATP; { Free DOS utility: Yet Another "Tree" Program. }
    (*   I got much of the code for this program, particularly
         the "DisplayDir" and "ReadFiles" Procedures, from:
       ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
       º  VTree2                                              º
       º  Version 1.6, 7-16-90 -- Public Domain by John Land  º
       º  (Found in SWAG, in the DIRS library)                º
       ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼
    *)
    {$M 32768,0,655360} { Allow a HUGE stack because of heavy recursion. }
    {  ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³ USES AND GLOBAL VARIABLES & CONSTANTS              ³
       ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ  }

    USES
      Crt, DOS;

    CONST
      NL        = #13#10;
      NonVLabel = ReadOnly + Hidden + SysFile + Directory + Archive;
      LevelMax  = 16;

    TYPE
      FPtr      = ^Dir_Rec;
      Dir_Rec   = RECORD                           { Double Pointer Record    }
                    DirName : STRING [14];
                    DirNum  : INTEGER;
                    Next    : Fptr;
                  END;

    VAR
      Dir       : STRING;
      Loop,
      tooDeep   : BOOLEAN;
      Level     : INTEGER;
      Flag      : ARRAY [1..LevelMax] OF STRING [2];
      Filetotal,
      Bytetotal,
      Dirstotal : LONGINT;
      ColorCnt  : WORD;

      ClusterSize : WORD;
      TotalClusters : LONGINT;

    PROCEDURE ShowHelp (CONST problem : BYTE);
    (* If any *foreseen* errors arise, we are sent here to
       give a little help and exit (relatively) peacefully *)
    CONST
      progdesc = 'YATP v1.00 - Free DOS utility: Yet Another "Tree" Program.';
      author   = 'July 3, 1995.  Copyright (c) 1995 by David Daniel Anderson - Reign Ware.' + NL;
      usage    = 'Usage:  YATP [drive:][\][directory]' + NL;
      notes    = 'Notes:  All parameters are optional; output may be piped or redirected.' + NL;
      examples = 'Examples:' + NL;
      examp1   = '        YATP                   <- all directories below current';
      examp2   = '        YATP c:\               <- all directories on drive C:';
      examp3   = '        YATP d:\os2\           <- only directories below D:\OS2';
      examp4   = '        YATP c:\ | list /s     <- pipe C: tree to LIST' + NL;
    VAR
      message : STRING [50];
    BEGIN
      WriteLn (progdesc);
      WriteLn (author);
      WriteLn (usage);
      WriteLn (notes);
      WriteLn (examples);
      WriteLn (examp1);
      WriteLn (examp2);
      WriteLn (examp3);
      WriteLn (examp4);
      IF problem > 0 THEN BEGIN
        CASE problem OF
          1 : message := 'Invalid drive or directory.';
          ELSE  message := 'Unanticipated error of unknown type.';
        END;
        WriteLn (#7, message);
      END;
      Halt (problem)
    END;

    FUNCTION Format (Num : LONGINT) : STRING;      {converts Integer to String}
    VAR NumStr : STRING;                           {& inserts commas as needed}
      l : SHORTINT;
    BEGIN
      Str (Num, NumStr);
      l := (Length (NumStr) - 2);
      WHILE (l > 1) DO BEGIN
        Insert (',', NumStr, l);
        Dec (l, 3);
      END;
      Format := NumStr;
    END;

    FUNCTION OutputRedirected : BOOLEAN; (* FROM SWAG *)
    VAR Regs : REGISTERS; Handle : WORD ABSOLUTE Output;
    BEGIN
      WITH Regs DO
      BEGIN
        AX := $4400;
        BX := Handle;
        MsDos (Regs);
        IF DL AND $82 = $82 THEN OutputRedirected := FALSE
        ELSE OutputRedirected := TRUE;
      END; {With Regs}
    END; {OutputRedirected}

    PROCEDURE CheckForRedirection;
    BEGIN
      IF OutputRedirected THEN BEGIN
        WriteLn ('YATP output has been redirected.');
        Assign (Output, '');
      END
      ELSE
        AssignCrt (Output);
      Rewrite (Output);
    END;

    FUNCTION DirExists (filename: PATHSTR): BOOLEAN;
    VAR
      Attr : WORD;
      f    : FILE;
    BEGIN
      Assign (f, filename);
      GetFAttr (f, Attr);
      IF (DosError = 0) AND ((Attr AND Directory) = Directory)
      THEN DirExists := TRUE
      ELSE DirExists := FALSE;
    END;

    PROCEDURE ReadParameters;
    VAR
      Param   : STRING;
    BEGIN
      IF (ParamCount > 1) THEN ShowHelp (0);
      Param := STRING (Ptr (PrefixSeg, $0080)^);
      WHILE (Param [0] > #0) AND (Param [1] = #32) DO Delete (Param, 1, 1);

      IF (Pos ('?', Param) <> 0) OR (Pos ('/', Param) <> 0) THEN ShowHelp (0);

      Param := FExpand (Param);                    { Set Var to param. String }
      IF Param [Length (Param) ] = '\' THEN
        Dec (Param [0]);                           { Remove trailing backslash}

      Dir := Param;

      IF (Length (Param) = 2) AND (Param [2] = ':') THEN
        Param := Param + '\';                      {add backslash to test ROOT}

      IF NOT DirExists (Param) THEN
        ShowHelp (1);
    END;

    FUNCTION GetClusterSize (drive : BYTE): WORD;  { SWAG routine }
    VAR
      regs : REGISTERS;
    BEGIN
      regs. CX := 0;         {set for error-checking just to be sure}
      regs. AX := $3600;     {get free space}
      regs. DX := drive;     {0=current, 1=a:, 2=b:, etc.}
      MsDos (regs);
      getclustersize := regs. AX * regs. CX;       {cluster size!}
    END;

    PROCEDURE InitGlobalVars;
    BEGIN
      Dir       := '';                             { Init. global Vars.       }
      Loop      := TRUE;
      Level     := 0;
      tooDeep   := FALSE;
      Filetotal := 0;
      Bytetotal := 0;
      Dirstotal := 1;                              { Always have a root dir.  }
      ColorCnt  := 1;

      IF ParamCount > 0 THEN
        ReadParameters                             { Deal With any params.    }
      ELSE
        GetDir (0, Dir);

      TotalClusters := 0;
      ClusterSize := (GetClusterSize (Ord (UpCase (Dir [1])) - 64));
      IF ClusterSize = 0
      THEN ShowHelp (1);
    END;

    PROCEDURE DisplayHeader;
    BEGIN
      WriteLn ('             File size   Files   Directory name');
      WriteLn ('ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
    END;

    PROCEDURE CalculateWaste (VAR SR: SEARCHREC);
    BEGIN
      IF ((SR. Attr AND Directory) <> Directory)
         AND ((SR. Attr AND VolumeID) <> VolumeID)
      THEN BEGIN
        TotalClusters := TotalClusters + (Sr. Size DIV ClusterSize);
        IF ((Sr. Size MOD ClusterSize) <> 0) THEN Inc (TotalClusters, 1);
      END;
    END;

    PROCEDURE DisplayDir (DirP, DirN : STRING; Levl,
                         NumSubsVar2, SubNumVar2, NumSubsVar3, 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
      Blank    = #32;
    VAR
      BegLine,
      WrtStr,
      FlagStr : STRING;
      FlagIndex : BYTE;

    BEGIN
      BegLine := '';                               { Init. Variables          }
      IF Levl > LevelMax THEN
      BEGIN
        tooDeep := TRUE;
        Exit;
      END;

      IF Levl = 0 THEN                             { Special handling For     }
        IF Dir = '' THEN                           { initial (0) dir. level   }
          WrtStr := 'ROOT'
        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 + Blank;
        END
        ELSE                                       { otherwise, use ÃÄ symbol }
        BEGIN                                      { & set flag padded With   }
          BegLine     := 'ÃÄ';                     { blanks                   }
          Flag [Levl] := '³' + Blank;
        END;

        FlagStr := '';
        FOR FlagIndex := 1 TO Levl - 1 DO          { Insert ³ & blanks as     }
          FlagStr := FlagStr + Flag [FlagIndex];   { needed, based on level   }
        BegLine := FlagStr + BegLine;

        WrtStr := BegLine + 'ÄÄ' + DirN;
        IF (NumSubsVar3 <> 0) THEN                 { if cur. level has subs   }
          IF Levl < LevelMax THEN                  { then change to "T" off   }
            WrtStr [Length (BegLine) + 1] := 'Â'
          ELSE                                     { if levelMax, special end }
            WrtStr := WrtStr + 'Ä>';               { to indicate more levels  }
      END;                                         { end level 1+ routines    }

      IF Odd (ColorCnt) THEN
        TextColor (15)
      ELSE
        TextColor (9);
      Inc (ColorCnt);

      WriteLn (Format (FilLen): 22, Format (NmbrFil): 8, '': 3, WrtStr)
                                                   { Write # of Files & Bytes  }
    END;

    PROCEDURE ReadFiles (DirPrev, DirNext : STRING;
                         SubNumVar1, NumSubsVar1 : INTEGER);

    VAR
      FileInfo  : SEARCHREC;
      FileBytes : LONGINT;
      NumFiles,
      NumSubs   : INTEGER;
      Dir_Ptr,
      CurPtr,
      FirstPtr  : FPtr;

    BEGIN
      FileBytes := 0;
      NumFiles  := 0;
      NumSubs   := 0;
      Dir_Ptr   := NIL;
      CurPtr    := NIL;
      FirstPtr  := NIL;

      IF (DirNext = '') AND (DirPrev [Length (DirPrev) ] = '\') THEN
        Dec (DirPrev [0]);                         { Avoid double backslashes }
      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 [1] <> '.') THEN
        BEGIN
          IF ((FileInfo. Attr AND Directory) = Directory) THEN
          BEGIN                                    { if fetched File is dir., }
            New (Dir_Ptr);                         { store a Record With dir. }
            Dir_Ptr^. DirName  := FileInfo. Name;  { name & occurence number, }
            Inc (NumSubs);                         { and set links to         }
            Dir_Ptr^. DirNum   := NumSubs;         { other Records if any     }
            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;
            CalculateWaste (FileInfo);
            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;
                                                   { Decrement level when     }
      Dec (Level);                                 { finish a recursive loop  }
                                                   { call to lower level of   }
    END;                                           { subdir.                  }

    PROCEDURE WriteDriveInfo;
    VAR DS, DF : LONGINT;   {bytes of *partition* space Size/Free}
      Disk : BYTE;
      Percent : STRING[6];
    BEGIN
      Disk := (Ord (UpCase (Dir [1])) - 64);

      DS := DiskSize (Disk);
      IF (DS < 0) THEN BEGIN
        DS := 0;
        DF := 0;
      END
      ELSE
        DF := DiskFree (Disk);

      IF DS = 0
      THEN Percent := ('0.00')
      ELSE Str ((100 * (DF / DS)): 0: 2, Percent);

      WriteLn ('Free:  ', Format (DF): 15,
      ' bytes out of ', Format (DS),
      ' (', percent, '% of drive is unused)');
    END;

    PROCEDURE DisplayTally;
    VAR
      WasteSpace,
      TotalSpace  : LONGINT;
    BEGIN
      WriteLn ('ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
      WriteLn ('Totals:', Format (Bytetotal): 15, Format (Filetotal): 8, '(': 4, Dirstotal, ' directories)');

      TotalSpace := (TotalClusters * ClusterSize);
      WasteSpace := (TotalSpace - Bytetotal);
      WriteLn ('Using: ', Format (TotalSpace): 15,
      ' bytes altogether (based on ', ClusterSize, ' bytes per cluster)');
      Write   ('Making:', Format (WasteSpace): 15, ' bytes wasted (');
      IF Bytetotal = 0
      THEN Write ('0.00')
      ELSE Write (100 * (WasteSpace / TotalSpace): 0: 2);
      WriteLn ('% of the space used is wasted)');

      WriteDriveInfo;
    END;

    {  ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³ Main Program                                       ³
       ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ  }

    BEGIN

      ClrScr;
      CheckForRedirection;                         { Get ready ...            }

      InitGlobalVars;                              { Get set ...              }

      TextColor (Cyan);
      DisplayHeader;                               { Display Header           }

      ReadFiles (Dir, '', 0, 0);                   { Go! do main read routine }

      TextColor (Cyan);
      DisplayTally;                                { Display totals           }

      IF tooDeep THEN
        WriteLn (NL, NL, '': 21, '¯ CANNOT DISPLAY MORE THAN ', LevelMax, ' LEVELS ®', NL);
                                                   { if ReadFiles detects > 16}
                                                   { levels, tooDeep flag set }

    END.                                           { Finish.                  }

                                     YATP v1.00
                      DOS utility: Yet Another "Tree" Program
                        Freeware, copyright (c) July 3, 1995
                                         by
                               David Daniel Anderson
                                     Reign Ware

                      ** READ REIGNWAR.TXT FOR LEGAL TERMS **

    YATP is Yet Another "Tree" Program.  YATP displays the directory structure
    of the drive and/ or directory that you specify, or if none is specified,
    the drive and directory structure of the current directory is displayed.

    Usage:  YATP [drive:][\][directory]

    Notes:  All parameters are optional; output may be piped or redirected.

    Examples:

            YATP                   <- all directories below current
            YATP c:\               <- all directories on drive C:
            YATP d:\os2\           <- only directories below D:\OS2
            YATP c:\ | list /s     <- pipe C: tree to LIST

    Enter "YATP ?" to display this short reminder of the syntax.

                      ** READ REIGNWAR.TXT FOR LEGAL TERMS **

[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]