home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / tricks / tree.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-21  |  3.0 KB  |  112 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     TREE.PAS                           *)
  3. (*         Sichtbarmachen von Baumstrukturen              *)
  4. (*         (c) 1989 by Manfred Jahn & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Tree;
  7. USES Crt, Dos;
  8.  
  9. CONST levels  = 12;
  10.       maxdirs = 255;
  11. TYPE
  12.   string66 = STRING[66];
  13.   string12 = STRING[12];
  14.   entryrec = RECORD
  15.                pathname : string66;
  16.                lastname : string12;
  17.                leader   : string12;
  18.   END;
  19.   entryarray = ARRAY[1..maxdirs] OF entryrec;
  20.  
  21. VAR
  22.   lw       : STRING[3];
  23.   elements : 1..maxdirs;
  24.   T        : entryarray;
  25.  
  26. PROCEDURE Initial(VAR x1 : entryrec);
  27. BEGIN
  28.   x1.pathname := lw;
  29.   x1.lastname := lw;
  30.   x1.leader   := '';
  31. END;
  32.  
  33. PROCEDURE GetDirs(path  : STRING; prefix : string12;
  34.                   VAR X : entryarray);
  35. VAR dir: searchrec;
  36. BEGIN
  37.   FindFirst(path + '*.*', directory, dir);
  38.   WHILE DosError = 0 DO BEGIN
  39.     IF (dir.attr AND directory) > 0 THEN BEGIN
  40.       IF dir.name[1]<>'.' THEN BEGIN
  41.         Inc(elements);
  42.         X[elements].pathname := path + dir.name;
  43.         X[elements].lastname := dir.name;
  44.         X[elements].leader   := prefix + 't';
  45.         GetDirs(path + dir.name + '\', prefix + 'b', X);
  46.       END;
  47.     END;
  48.     FindNext(dir);
  49.   END;
  50. END; { GetDirs }
  51.  
  52. PROCEDURE ArrangeDirs(VAR X : entryarray);
  53. VAR a, i   : INTEGER;
  54.     bi, tl : BOOLEAN;
  55.     c      : CHAR;
  56. BEGIN
  57.    FOR a := 1 TO elements DO
  58.      FOR i := 1 TO 13 - Length(X[a].leader) DO
  59.        X[a].leader := X[a].leader + '0';
  60.    bi := FALSE; tl := TRUE;
  61.    IF elements > 1 THEN
  62.      FOR i := 1 TO 12 DO BEGIN
  63.        a := elements + 1;
  64.        REPEAT
  65.          Dec(a);
  66.          c := X[a].leader[i];
  67.          IF bi THEN
  68.            IF c='b' THEN c := 'i';
  69.          IF tl AND (c = 't') THEN BEGIN
  70.            c := 'l';  bi := TRUE;  tl := FALSE;
  71.          END;
  72.          IF c = '0' THEN BEGIN
  73.            bi := FALSE;  tl := TRUE;
  74.          END;
  75.          X[a].leader[i] := c;
  76.        UNTIL a = 1;
  77.      END;
  78. END;  { ArrangeDirs }
  79.  
  80. PROCEDURE ListDirs(VAR X: entryarray);
  81. VAR a, i: INTEGER;
  82. BEGIN
  83.   WriteLn(elements, ' Einträge gefunden.');
  84.   WriteLn;
  85.   WriteLn('Katalogbaum                  Pfadnamen  ');
  86.   WriteLn('----------------------------------------');
  87.   FOR a := 1 TO elements DO BEGIN
  88.     FOR i:=1 TO levels DO
  89.       CASE X[a].leader[i] OF
  90.         'b': Write('  ');    { = 2 Blanks }
  91.         'i': Write('│ '); { = #179, Blank }
  92.         't': Write('├─'); { = #195, #196  }
  93.         'l': Write('└─'); { = #192, #196  }
  94.       END;
  95.     Write(X[a].lastname);
  96.     GotoXY(30, WhereY);
  97.     WriteLn(X[a].pathname);
  98.   END;
  99. END; { ListDirs }
  100.  
  101. BEGIN
  102.   ClrScr;
  103.   Write('Welches Laufwerk? - '); ReadLn(lw);
  104.   lw := UpCase(lw[1]) + ':\';
  105.   elements := 1;
  106.   initial(T[1]);
  107.   getdirs(lw, '', T);
  108.   arrangedirs(T);
  109.   listdirs(T);
  110. END.
  111. (* ------------------------------------------------------ *)
  112. (*                   Ende von TREE.PAS                    *)