home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 08_09 / rekursiv / library.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-31  |  7.1 KB  |  243 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     LIBRARY.PAS                        *)
  3. (*             Rekursive Arbeitsprozeduren                *)
  4. (* ------------------------------------------------------ *)
  5. UNIT      library;
  6.  
  7. INTERFACE
  8.  
  9. USES      dos, crt, header;
  10.  
  11. VAR       i             : BYTE     ;
  12.           subdir        : textline ;    (* Aktueller Pfad *)
  13.           (* folgende Variablen sind für die Statistiken: *)
  14.           mem_found     ,
  15.           mem_count     : longint  ;
  16.           fil_found     ,
  17.           fil_count     ,
  18.           dir_count     : INTEGER  ;
  19.  
  20. PROCEDURE set_cursor (    cursor : word);
  21. PROCEDURE get_cursor (VAR cursor : word);
  22. PROCEDURE recurse (deep : word);
  23.  
  24. IMPLEMENTATION
  25.  
  26. (* ------------------------------------------------------ *)
  27. PROCEDURE set_cursor (cursor : word);
  28.  
  29.   BEGIN
  30.     WITH regs DO BEGIN
  31.       ax := $0100 ;
  32.       cx := cursor;
  33.       intr ($10,regs);
  34.     END;
  35.   END;
  36.  
  37. (* ------------------------------------------------------ *)
  38. PROCEDURE get_cursor (VAR cursor : word);
  39.  
  40.   BEGIN
  41.     WITH regs DO BEGIN
  42.       ax := $0300;
  43.       intr ($10,regs);
  44.       cursor    := cx;
  45.     END;
  46.   END;
  47.  
  48. (* ------------------------------------------------------ *)
  49. PROCEDURE abort_program;
  50.  
  51.   BEGIN
  52.     WriteLn;  WriteLn;  highvideo;
  53.     Write   ('':MAIN_MARGIN,PROG_NAME);
  54.     WriteLn (' -->  Programm vom Benutzer abgebrochen.');
  55.     LowVideo;
  56.     chdir(Copy(start_path,3,80));
  57.     set_cursor (DOScursor);    (* DOS-Cursor zurücksetzen *)
  58.     Halt;                      (* Program abbrechen       *)
  59.   END;
  60.  
  61. (* ------------------------------------------------------ *)
  62. PROCEDURE pause;
  63.  
  64.   BEGIN
  65.     IF IS_ECHO THEN Delay(OUTPUT_DELAY);
  66.   END;
  67.  
  68. (* ------------------------------------------------------ *)
  69. PROCEDURE wait;
  70.   VAR ch : CHAR;
  71.   BEGIN
  72.     ch := readkey;
  73.     CASE ch OF
  74. {^S}  #19 : REPEAT            { CTRL-S --> warten, bis ... }
  75.               ch := readkey;
  76.               IF ch = #3 THEN abort_program;
  77. {^Q}        UNTIL ch = #17;   { ... CTRL-Q eingegeben wird }
  78. {^C}  #3  : abort_program;    { CTRL-C / CTRL-BREAK        }
  79.    END;
  80.  END;
  81.  
  82. (* ------------------------------------------------------ *)
  83. PROCEDURE show_dirname (deep: BYTE);
  84.   VAR   path : textline;
  85.   BEGIN
  86.     IF IS_ECHO THEN BEGIN
  87.       getdir(0,path);
  88.       Write('':MAIN_MARGIN);
  89.       IF recursive THEN Write('':(deep SHL 1));
  90.       highvideo;  WriteLn(path);  LowVideo;
  91.       IF KeyPressed THEN wait ELSE pause;
  92.     END;
  93.   END;
  94.  
  95. {$IFDEF dir_recurse}
  96. (* ------------------------------------------------------ *)
  97. PROCEDURE show_filename(dta : searchrec; deep : BYTE);
  98.   VAR p : BYTE; dati : datetime;
  99.   BEGIN
  100.     IF IS_ECHO THEN BEGIN
  101.       Write('':(deep SHL 1));
  102.       WITH dta DO BEGIN
  103.         p := 0;
  104.         IF (attr AND directory <> directory) OR
  105.           NOT recursive THEN LowVideo
  106.         ELSE highvideo;
  107.         IF (name <> '.') AND  (name <> '..') THEN
  108.           p := Pos('.',name);
  109.         IF p = 0 THEN
  110.           Write('':WORK_MARGIN,name,'':12-Length(name))
  111.         ELSE Write('':WORK_MARGIN, Copy(name,1,Pred(p)),
  112.                    '':9-Length(Copy(name,1,Pred(p))),
  113.         Copy(name,Succ(p),3),'':3-
  114.              Length(Copy(name,Succ(p),3)) );
  115.       END;
  116.       WITH dta, dati DO BEGIN
  117.         unpacktime(time,dati);
  118.         IF size_on THEN
  119.           IF (name = '.') THEN Write('<DIR> ':8) ELSE
  120.             IF (name = '..') THEN Write('<DIR> ':8) ELSE
  121.               IF (attr AND directory = directory ) THEN
  122.                 Write('<DIR> ':8)
  123.               ELSE
  124.                 IF (attr AND volumeid  = volumeid )  THEN
  125.                   Write('VOLUME':8)
  126.                 ELSE Write(size:8);
  127.         IF date_on THEN BEGIN
  128.           IF day   < 10 THEN Write('0':3,day)
  129.           ELSE Write(day:4);
  130.           IF month < 10 THEN Write('.0',month)
  131.           ELSE Write('.',month:2);
  132.           Write('.',year MOD 100:2);
  133.         END;
  134.         IF time_on THEN BEGIN
  135.           IF hour  < 10 THEN Write('0':3,hour)
  136.           ELSE Write(    hour:4);
  137.           IF min   < 10 THEN Write(':0' ,min )
  138.           ELSE Write(':', min:2);
  139.         END;
  140.         IF attr_on THEN BEGIN
  141.           Write('  ');
  142.           IF (attr AND archive   = archive  ) THEN
  143.             Write('A');
  144.           IF (attr AND sysfile   = sysfile  ) THEN
  145.             Write('S');
  146.           IF (attr AND readonly  = readonly ) THEN
  147.             Write('R');
  148.           IF (attr AND hidden    = hidden   ) THEN
  149.             Write('H');
  150.           IF (attr AND volumeid  = volumeid ) THEN
  151.             Write('V');
  152.           IF (attr AND directory = directory) THEN
  153.             Write('D');
  154.         END;
  155.         WriteLn;
  156.       END;
  157.       IF KeyPressed THEN wait ELSE pause;  LowVideo;
  158.     END;
  159.     Delay(DEFAULT_DELAY);
  160.   END;
  161. {$ENDIF}
  162.  
  163. (* ------------------------------------------------------ *)
  164. PROCEDURE recurse (deep : word);
  165.   VAR dta : searchrec;
  166.   BEGIN
  167.     IF deep > 0 THEN chdir(subdir);
  168.     findfirst ('*.*',directory,dta);
  169.     WHILE DOSerror = 0 DO BEGIN
  170.       WITH dta DO
  171.         IF (attr AND directory = directory) THEN BEGIN
  172.           IF (name <> '.') AND (name <> '..') THEN BEGIN
  173.             IF recursive THEN BEGIN
  174.               inc(dir_count);
  175.               subdir := name;
  176.               recurse (Succ(deep));
  177. {$IFDEF dir_recurse}
  178.             END
  179.             ELSE show_filename(dta,deep);
  180. {$ELSE}
  181.           END;
  182. {$ENDIF}
  183.         END;
  184.       END;
  185.       findnext (dta);
  186.     END;
  187.     show_dirname (deep);
  188.     mem_found := 0;
  189.     fil_found := 0;
  190.     FOR i := 1 TO MAXPATTERN DO
  191.       IF (pattern[i][0] <> #0) THEN BEGIN
  192. {$IFDEF clean_recurse}
  193.         fil_found := 0;
  194.         mem_found := 0;
  195.         Write('':MAIN_MARGIN+(deep SHL 1),
  196.         pattern[i]:12,fil_found:12,' Datei(en) gefunden');
  197. {$ENDIF}
  198.         findfirst(pattern[i],$22,dta);
  199.         WHILE DOSerror = 0 DO BEGIN
  200.           inc(fil_found);
  201.           inc(mem_found,dta.size);
  202. {$IFDEF clean_recurse}
  203.           IF IS_ECHO THEN BEGIN
  204.             GotoXY(1,wherey);
  205.             Write('':MAIN_MARGIN+(deep SHL 1),
  206.                   pattern[i]:12,fil_found:12,
  207.                   ' Datei(en) gefunden');
  208.           END;
  209.           Assign(deletefile,dta.name);
  210.          {$I-} Erase(deletefile);   {SI+}
  211. {$ELSE}
  212.           show_filename(dta,deep);
  213. {$ENDIF}
  214.           IF KeyPressed THEN wait ELSE pause;
  215.           findnext(dta);
  216.         END;
  217. {$IFDEF clean_recurse}
  218.         IF IS_ECHO THEN WriteLn;
  219. {$ENDIF}
  220.         inc(fil_count,fil_found);
  221.         inc(mem_count,mem_found);
  222.    END;
  223. {$IFDEF dir_recurse}
  224.    IF IS_ECHO THEN BEGIN
  225.      Write('':WORK_MARGIN+10);
  226.      IF recursive THEN Write('':(deep SHL 1));
  227.      IF fil_found = 0 THEN WriteLn(' Keine Datei gefunden')
  228.      ELSE WriteLn(mem_found:10,'  Byte in ',
  229.                   fil_found   ,' Datei(en) ');
  230.   END;
  231. {$ENDIF}
  232.   IF deep > 0 THEN chdir ('..');
  233. END;
  234.  
  235. (* ------------------------------------------------------ *)
  236. BEGIN
  237.   mem_count := 0;
  238.   fil_count := 0;
  239.   dir_count := 1;
  240. END.
  241. (* ------------------------------------------------------ *)
  242. (*                Ende von LIBRARY.PAS                    *)
  243.