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