home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 13 / sonstige / such.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-17  |  5.1 KB  |  181 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     SUCH.PAS                           *)
  3. (*          sucht Files in allen Verzeichnissen           *)
  4. (*                des aktuellen Laufwerks                 *)
  5. (*                   Turbo Pascal 3.0                     *)
  6. (*  (c) 1988 by Gerd Brinkmann & PASCAL International     *)
  7. (* ------------------------------------------------------ *)
  8.  
  9. PROGRAM Such;
  10.  
  11. TYPE
  12.   str             = STRING[64];
  13.   register        = RECORD
  14.                       ax,bx,cx,dx,bp,si,di,ds,es : INTEGER;
  15.                     END;
  16. VAR
  17.   akt_Verzeichnis,
  18.   such_datei       : str;
  19.   verz_stack       : ARRAY[0..255] OF Str;
  20.   stackanfang,
  21.   stackende        : BYTE;
  22.   dateien          : INTEGER;
  23.  
  24. (* ------------------------------------------------------ *)
  25. PROCEDURE Push_Dir ( name : str );
  26.        (*  schiebt einen String auf den Verzeichnisstack  *)
  27.  
  28. BEGIN
  29.   verz_stack[stackanfang] := akt_Verzeichnis + '\' + name;
  30.   stackanfang := SUCC(stackanfang);
  31. END;
  32.  
  33. (* ----------------------------------------------------- *)
  34. PROCEDURE Pop_Dir ( VAR name : Str );
  35.  
  36. (*  holt einen String vom Verzeichnisstack und           *)
  37. (*  setzt das aktuelle Directory auf diesen String       *)
  38.  
  39. BEGIN
  40.   name := verz_stack[stackende];
  41.   stackende := SUCC(stackende);
  42.   ChDir(name);
  43. END;
  44.  
  45. (* ----------------------------------------------------- *)
  46. PROCEDURE Hole_DTA ( VAR es, bx : INTEGER );
  47.  
  48.                          (*  Disk Tranfer Adresse lesen  *)
  49. VAR
  50.   reg : register;
  51. BEGIN
  52.   reg.ax := $2F00;
  53.   MsDos(reg);
  54.   es := reg.es;
  55.   bx := reg.bx;
  56. END;
  57.  
  58. (* ----------------------------------------------------- *)
  59. PROCEDURE such_ersten_Eintrag ( such_string : str;
  60.                                 attribut    : INTEGER;
  61.                                 VAR status  : INTEGER );
  62.  
  63. (*  ersten Verzeichnis-Eintrag, der den Suchkriterien    *)
  64. (*  in 'such_string' und 'attribut' genügt, suchen       *)
  65.  
  66. VAR
  67.   reg : register;
  68. BEGIN
  69.   such_string := such_string + #0;
  70.   reg.ax := $4E00;
  71.   reg.ds := Seg(such_string[1]);
  72.   reg.dx := Ofs(such_string[1]);
  73.   reg.cx := attribut;
  74.   MsDos(reg);
  75.   status := Lo(reg.ax);
  76. END;
  77.  
  78. (* ----------------------------------------------------- *)
  79. PROCEDURE such_weiteren_Eintrag ( VAR status : INTEGER );
  80.  
  81.                 (*  nächsten Verzeichnis-Eintrag suchen  *)
  82.  
  83. VAR
  84.   reg : register;
  85. BEGIN
  86.   reg.ax := $4F00;
  87.   MsDos(reg);
  88.   status := Lo(reg.ax);
  89. END;
  90.  
  91. (* ----------------------------------------------------- *)
  92. PROCEDURE Hole_Name ( VAR file_name : str );
  93.  
  94. (*  Name des gefundenen Eintrags aus der DTA extrahieren *)
  95.  
  96. VAR
  97.   es, bx : INTEGER;
  98. BEGIN
  99.   Hole_DTA(es,bx);
  100.   bx := bx + 30;
  101.   file_name := '';
  102.   WHILE mem[es:bx] <> 0 DO BEGIN
  103.     file_name := file_name + CHR(mem[es:bx]);
  104.     bx := SUCC(bx);
  105.   END;
  106. END;
  107.  
  108. (* ----------------------------------------------------- *)
  109. PROCEDURE such_Eintraege ( such_string : str );
  110.  
  111. (*  sucht im aktuellen Directory erst nach Verzeichnis-  *)
  112. (*   einträgen, die auf den Verzeichnis-Stack kommen und *)
  113. (*  dann nach Einträgen, die dem Suchstring genügen      *)
  114.  
  115. VAR
  116.   file_name      : str;
  117.   es, bx, status : INTEGER;
  118. BEGIN
  119.   Hole_DTA(es,bx);
  120.   such_ersten_Eintrag('*.   ', 18, status);
  121.   WHILE status = 0 DO BEGIN
  122.     IF (mem[es:bx+21] AND 16) = 16 THEN BEGIN
  123.       Hole_Name(file_name);
  124.       IF file_name[1] <> '.' THEN Push_Dir(file_name)
  125.     END;
  126.     such_weiteren_Eintrag(status);
  127.   END;
  128.   such_ersten_Eintrag(such_string, 39, status);
  129.   WHILE status = 0 DO BEGIN
  130.     dateien := SUCC(dateien);
  131.     Hole_Name(file_name);
  132.     WriteLn(akt_Verzeichnis,'\',file_name);
  133.     such_weiteren_Eintrag(status);
  134.   END;
  135. END;
  136.  
  137. (* ----------------------------------------------------- *)
  138. PROCEDURE Suche ( such_string : str );
  139.  
  140.         (*  steuert die Suche durch den Verzeichnisbaum  *)
  141. VAR
  142.   Start_Verzeichnis : str;
  143.   dirs              : INTEGER;
  144. BEGIN
  145.   GetDir(0,Start_Verzeichnis);
  146.   akt_Verzeichnis := '';
  147.   ChDir('\');                 (* Root-Verzeichnis setzen *)
  148.   stackanfang := 0;                    (* Stack          *)
  149.   stackende   := 0;                    (* initialisieren *)
  150.   dateien := 0;
  151.   dirs    := 1;
  152.   such_Eintraege(such_string);
  153.   WHILE stackanfang <> stackende DO BEGIN
  154.                                        (*  Stack leer ?  *)
  155.     dirs := SUCC(dirs);
  156.     Pop_Dir(akt_Verzeichnis);
  157.     such_Eintraege(such_string);
  158.   END;
  159.   WriteLn;
  160.   Write('Es wurden ',dirs,' Verzeichnis(se) durchsucht');
  161.   WriteLn(' und ',dateien,' Datei(en) gefunden');
  162.   ChDir(Start_Verzeichnis);
  163. END;
  164.  
  165. (*-------------------  HAUPTPROGRAMM  -------------------*)
  166. BEGIN
  167.   WriteLn;
  168.   IF ParamCount > 0 THEN such_datei := Paramstr(1)
  169.   ELSE BEGIN
  170.     Write('Bitte Suchbegriff eingeben : ');
  171.     ReadLn(such_datei)
  172.   END;
  173.   IF (POS('\',such_datei) > 0) OR
  174.                               (POS(':',such_datei) > 0) THEN
  175.     WriteLn('Pfad- oder Laufwerksangaben ',
  176.             'sind nicht erlaubt !')
  177.   ELSE
  178.     IF such_datei <> '' THEN Suche(such_datei);
  179. END.
  180. (* ------------------------------------------------------ *)
  181. (*               Ende von SUCH.PAS                        *)