home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / tricks / dbbaum.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-09  |  5.8 KB  |  188 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       DBBAUM.PAS                       *)
  3. (*        (c) 1990  Michael Winter  &  TOOLBOX            *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM DBBaum;
  6.  
  7. {$M 65520,0,655360, $S-, $R-}
  8.  
  9. USES Crt, Dos;
  10.  
  11. CONST
  12.   zeilmax = 53;          { max. Zeilenanzahl auf Ausdruck  }
  13.   tab     = 65;          { Position des Kommentarausgedrus }
  14.   maxanz  = 20;          { max. aufrufbare Unterprogramme  }
  15.  
  16.  
  17. VAR
  18.   abtiefe, laenge, seiten, zeilen, spaces, y : INTEGER;
  19.   haupt                                      : STRING;
  20.   ok                                         : BOOLEAN;
  21.   baumzeile                                  : TEXT;
  22.   j, m, t, w                                 : WORD;
  23.  
  24.   PROCEDURE Kopf;
  25.   VAR
  26.     dir : STRING;
  27.   BEGIN
  28.     GetDir(0, dir);
  29.     IF seiten > 1 THEN WriteLn(baumzeile, chr(12));
  30.     zeilen := 0;
  31.     WriteLn(baumzeile, chr(18));       { Schmalschrift aus }
  32.     WriteLn(baumzeile, 'DBBAUM / ', t, '.', m, '.', j,
  33.          '          Programm-, Unterprogrammstruktur     ');
  34.     Write  (baumzeile, '     Michael Winter & TOOLBOX    ',
  35.                 '                                        ');
  36.     WriteLn(baumzeile, '    Seite: ', seiten:3);
  37.     WriteLn(baumzeile, '---------------------------------',
  38.                        '---------------------------------',
  39.                        '---------------------');
  40.     Inc(seiten);
  41.     WriteLn(baumzeile, ' ');
  42.     WriteLn(baumzeile, dir);
  43.     WriteLn(baumzeile, chr(15));       { Schmalschrift ein }
  44.   END;
  45.  
  46.   PROCEDURE MakeTree(VAR prog : STRING);
  47.   VAR
  48.     zeile, datum : STRING;
  49.     gefunden     : ARRAY [0..maxanz] OF STRING;
  50.     datei        : text;
  51.     anzahl,
  52.     zaehler,
  53.     position, x  : INTEGER;
  54.  
  55.     PROCEDURE QuickSort(l, r : INTEGER);
  56.     VAR
  57.       i, k : INTEGER;
  58.       a, b : STRING;
  59.     BEGIN
  60.       i := l;  k := r;  a := gefunden[(l + r) DIV 2];
  61.       REPEAT
  62.         WHILE gefunden[i] < a DO i := i + 1;
  63.         WHILE a < gefunden[k] DO k := k - 1;
  64.         IF i <= k THEN BEGIN
  65.           b := gefunden[i];
  66.           gefunden[i] := gefunden[k];
  67.           gefunden[k] := b;
  68.           i := i + 1;  k := k - 1;
  69.         END;
  70.       UNTIL i > k;
  71.       IF l < k THEN QuickSort(l, k);
  72.       IF i < r THEN QuickSort(i, r);
  73.     END;
  74.  
  75.   BEGIN
  76.     laenge := 0;
  77.     spaces := spaces + 3;
  78.     GotoXY(2,24);
  79.     Write('Stufe : ', spaces DIV 3:3, '   ',
  80.            prog,'              ');
  81.     GotoXY(60,24);  Write('lesen...         ');
  82.     FOR x := 1 TO spaces DO Write(baumzeile, chr(32));
  83.     Write(baumzeile, Copy(prog, 1, Length(prog) - 4), ' ');
  84.     Inc(zeilen);
  85.     anzahl  := 0;
  86.     zaehler := 0;
  87.     FOR x := 0 TO maxanz DO gefunden[x] := '';
  88.     Assign(datei, prog);
  89.     Reset(datei);
  90.     WHILE NOT EOF(datei) OR (zeile = 'RETURN') DO BEGIN
  91.       Inc(zaehler);
  92.       ReadLn(datei, zeile);
  93.       IF (Pos('DO ', zeile) > 0) OR
  94.          (Pos('do ', zeile) > 0) OR
  95.          (Pos('dO ', zeile) > 0) OR
  96.          (Pos('Do ', zeile) > 0) THEN BEGIN
  97.         FOR x := 1 TO Length(zeile) DO
  98.           zeile[x] := UpCase(zeile[x]);
  99.       END;
  100.       IF zaehler = 2 THEN BEGIN
  101.         datum  := zeile;
  102.         laenge := laenge + Length(zeile);
  103.       END;
  104.       IF zaehler = 5 THEN BEGIN
  105.         laenge := Length(zeile);
  106.         FOR x := 1 TO tab - spaces - Length(prog) DO
  107.           Write(baumzeile, '.');
  108.         Write(baumzeile, zeile, ' ', datum, ' ');
  109.       END;
  110.       IF zaehler = 8 THEN BEGIN
  111.         laenge := laenge + Length(zeile);
  112.         IF laenge + tab > 158 THEN
  113.           zeile := Copy(zeile, 1, 158 - tab);
  114.         WriteLn(baumzeile, zeile);
  115.       END;
  116.       IF (Pos('DO ', zeile) > 0) AND
  117.          (Pos('CASE', zeile) = 0) AND
  118.          (Pos('WHILE', zeile) = 0) AND
  119.          (Pos('ENDDO', zeile) = 0) THEN BEGIN
  120.         position := Pos('DO ', zeile) + 3;
  121.         gefunden[anzahl] := Copy(zeile, position,
  122.                                  Length(zeile)-position+1) +
  123.                                  '.PRG';
  124.         Inc(anzahl);
  125.         IF anzahl > 30 THEN BEGIN
  126.           ClrScr;
  127.           WriteLn('Zu viele Unterprogramme werden von ',
  128.                   prog, ' aufgerufen !');
  129.           Halt(5);
  130.         END;
  131.       END;
  132.     END;
  133.     IF zeilen = zeilmax THEN Kopf;
  134.     Close(datei);
  135.     GotoXY(60,24); Write('sortieren...   ');
  136.     IF (anzahl > 0) AND (spaces DIV 3 > abtiefe) THEN
  137.       QuickSort(0, anzahl - 1);
  138.     IF anzahl > 0 THEN
  139.       FOR x := 0 TO anzahl - 1 DO
  140.         IF gefunden[x] <> gefunden[x+1] THEN
  141.           MakeTree(gefunden[x]);
  142.     spaces := spaces - 3;
  143.   END;
  144.  
  145. BEGIN
  146.   GetDate(j, m, t, w);
  147.   ok     := FALSE;
  148.   spaces := -3;
  149.   zeilen := 0;
  150.   seiten := 1;
  151.   REPEAT
  152.     ClrScr;
  153.     GotoXY(15,15);
  154.     WriteLn('Ausgabedatei => BAUM.DOK');
  155.     GotoXY(20,5);
  156.     WriteLn('Programmaufbaubaum für dBASE-III-Programme');
  157.     GotoXy(2,10);
  158.     Write('Geben Sie bitte den Namen des ',
  159.           'Hauptprogramms ein : ');
  160.     ReadLn(haupt);
  161.     IF (haupt = '') OR
  162.        (haupt = 'ENDE') OR
  163.        (haupt = 'ende') THEN BEGIN
  164.       ClrScr;
  165.       Halt(0);
  166.     END;
  167.     FOR y := 1 TO Length(haupt) DO
  168.       haupt[y] := UpCase(haupt[y]);
  169.     IF (Length(haupt) <= 12) AND
  170.        (Pos('PRG', haupt) = Length(haupt) - 2) AND
  171.        (Pos('.', haupt) <> 0) THEN
  172.       ok:=TRUE;
  173.   UNTIL ok;
  174.   GotoXY(5,19);
  175.   Write(' Ab welcher Stufe den Baum sortieren : ');
  176.   ReadLn(abtiefe);
  177.   Assign(baumzeile, 'BAUM.DOK');
  178.   Rewrite(baumzeile);
  179.   Kopf;
  180.   MakeTree(haupt);
  181.   WriteLn(baumzeile, Chr(18), Chr(12));
  182.                        { Schmalschrift aus, Seitenvorschub }
  183.   Close(baumzeile);
  184.   ClrScr;
  185. END.
  186. (* ------------------------------------------------------ *)
  187. (*                Ende von DBBAUM.PAS                     *)
  188.