home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 11 / tricks / getdirs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-11  |  5.1 KB  |  135 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    GETDIRS.PAS                         *)
  3. (*        (c) 1989 by Hagen Lehmann & TOOLBOX             *)
  4. (* ------------------------------------------------------ *)
  5. {$R-,S-,I-,D-,F-,V-,B-,N-,L-}
  6. {$M 1024,0,0}
  7.  
  8. USES Crt, Dos;
  9.  
  10. CONST
  11.   CopyRight  = 'GETDIRS, (C) 1989 Hagen Lehmann & TOOLBOX';
  12.   Return     = ^M^J;
  13. TYPE
  14.   SearchArray    = ARRAY [1..100] Of SearchRec;
  15.   DirSearchArray = ARRAY [1..100] Of STRING;
  16.   DriveString    = STRING [2];
  17. VAR
  18.   Verzeichnisse  : DirSearchArray;
  19.   Gefundene,Loop : BYTE;
  20.   Parameter      : STRING;
  21.   Drive          : DriveString;
  22.  
  23.   PROCEDURE GetDirs(VAR Dateien : SearchArray;
  24.                     VAR Anzahl  : BYTE);
  25.   VAR
  26.     Suche : SearchRec;
  27.   BEGIN
  28.     Anzahl := 0;
  29.     FindFirst('*', Directory, Suche);
  30.     IF DosError = 0 THEN              { Eintrag vorhanden? }
  31.     REPEAT                          { ja, weitere einlesen }
  32.       Anzahl := Anzahl + 1;
  33.       IF Suche.Attr = Directory THEN
  34.         Dateien[Anzahl] := Suche             { abspeichern }
  35.       ELSE
  36.         Anzahl := Anzahl - 1;
  37.       FindNext(Suche);                     { nächster Pfad }
  38.     UNTIL (DosError <> 0) OR (Anzahl >= 100);       { Ende }
  39.   END;
  40.  
  41.   PROCEDURE GetAllDirs(Laufwerk     : DriveString;
  42.                        VAR Pfade    : DirSearchArray;
  43.                        VAR Gefunden : BYTE);
  44.   LABEL Ende;
  45.   VAR
  46.     Dateien                  : SearchArray;
  47.     Pfad, TestPfad           : STRING;
  48.     Anzahl, i, j, Getestet   : BYTE;
  49.     Vorhanden, NichtGefunden : BOOLEAN;
  50.   BEGIN
  51.     GetDir(0, Pfad);              { aktiven Pfad speichern }
  52.     ChDir(Laufwerk + '\');
  53.     GetDir(0, TestPfad);
  54.     For i := 1 TO 100 DO Pfade[i] := '';
  55.                                     { Pfadspeicher löschen }
  56.     Gefunden := 0;
  57.     Getestet := 1;
  58.     Pfade[1] := TestPfad[1] + ':\';  { Hauptpfad speichern }
  59.     GetDirs(Dateien, Anzahl);
  60.     IF Anzahl > 1 THEN
  61.                  { Kontrolle, ob überhaupt Pfade vorhanden }
  62.       REPEAT
  63.         GetDirs(Dateien, Anzahl);       { weitere einlesen }
  64.         IF (Dateien[1].Name = '.') AND
  65.            (Dateien[2].Name = '..') THEN BEGIN
  66.           FOR i := 1 TO Anzahl DO
  67.                       { die ersten beiden Einträge löschen }
  68.             Dateien[i] := Dateien[i + 2];
  69.           Anzahl := Anzahl - 2;
  70.         END;
  71.         IF Anzahl > 0 THEN BEGIN
  72.                         { sind sonst noch Pfade vorhanden? }
  73.           FOR i := 1 TO Anzahl DO BEGIN
  74.                             { ja, dann jeden kontrollieren }
  75.             ChDir(Dateien[i].Name);
  76.                             { in Unterverzeichnis wechseln }
  77.             GetDir(0, TestPfad);  { vollen Pfadnamen holen }
  78.             ChDir('..');                    { zurückkehren }
  79.             Vorhanden := FALSE;
  80.             FOR j := 1 TO Getestet DO
  81.                       { ist dieser Pfad schon gespeichert? }
  82.               IF Pfade[J] = TestPfad THEN Vorhanden := TRUE;                   { ja }
  83.             IF NOT Vorhanden THEN BEGIN
  84.               Getestet := Getestet + 1;
  85.                                  { dann Zähler erhöhen und }
  86.               Pfade[Getestet] := TestPfad;
  87.                                         { Pfad abspeichern }
  88.             END;
  89.           END;
  90.           Gefunden := Gefunden + 1;
  91.           NichtGefunden := TRUE;
  92.           ChDir(Pfade[Getestet]);
  93.                                { in nächsten Pfad wechseln }
  94.           IF IOResult <> 0 THEN GOTO Ende;
  95.                                    { ist dieser vorhanden? }
  96.         END ELSE BEGIN
  97.           IF NOT NichtGefunden THEN
  98.             Gefunden := Gefunden + 1;
  99.           ChDir(Pfade[Gefunden]);
  100.           IF IOResult <> 0 THEN GOTO Ende;
  101.           NichtGefunden := FALSE;
  102.         END;
  103.         IF Length(Pfade[Gefunden]) = 0 THEN GOTO Ende;
  104.       UNTIL (IOResult <> 0) OR (Getestet >= 100);
  105. Ende:
  106.     Gefunden := Getestet;     { Anzahl der Pfade übergeben }
  107.     ChDir(Pfad);      { altes Verzeichnis wiederherstellen }
  108.   END;
  109.  
  110. BEGIN
  111.   Parameter := ParamStr(1);              { Parameter holen }
  112.   Drive     := '';             { aktuelles Laufwerk setzen }
  113.   IF (UpCase(Parameter[1]) IN ['A'..'Z']) AND
  114.      (Parameter[2]=':') And (Length(Parameter) = 2) THEN
  115.     Drive := Parameter;
  116.   IF Parameter = '?' THEN BEGIN
  117.     ClrScr;
  118.     WriteLn;  WriteLn('Aufruf : GETDIRS [d:] ');  WriteLn;
  119.     WriteLn(' Beispiel :');
  120.     WriteLn('   A:\>getdirs a:');
  121.     WriteLn('    (sucht alle Pfade im Laufwerk A:)');
  122.     WriteLn('   A:\>getdirs');
  123.     WriteLn('    (sucht alle Pfade im aktuellen Laufwerk)');
  124.     Halt;                                   { Programmstop }
  125.   END;
  126.   WriteLn(CopyRight, Return);        { Copyright schreiben }
  127.   Write('Scanning disk to get tree information ...');
  128.   GetAllDirs(Drive, Verzeichnisse, Gefundene);
  129.   WriteLn(Return);
  130.   FOR Loop := 1 TO Gefundene DO
  131.     WriteLn(Verzeichnisse[Loop]);
  132.   WriteLn(Return, Gefundene, ' directories found.');
  133. END.
  134. (* ------------------------------------------------------ *)
  135. (*               Ende von GETDIRS.PAS                     *)