home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 08_09 / rekursiv / recurse.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-05-31  |  6.5 KB  |  202 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      RECURSE.PAS                       *)
  3. (*                Deklarations-Vorspann                   *)
  4. (* (c) 1988 by Frank A. Lohmeier und PASCAL International *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. {$M 65000,0,0}           (* stack = 65 kB wegen Rekursion *)
  8.                          (* heap wird nicht gebraucht     *)
  9. {$V-}
  10.  
  11. PROGRAM   recurse_utils;
  12.  
  13. USES      dos ,              (*     DOS standard library  *)
  14.           crt ,              (*  SCREEN standard library  *)
  15.           library,           (* WORKING routines          *)
  16.           header;            (*  HEADER module            *)
  17.  
  18. VAR       old_diskmem  : longint;
  19.  
  20. (* ------------------------------------------------------ *)
  21. (*   Sicherung des DOS-Status / erste Informationen       *)
  22. PROCEDURE start_program;
  23.  
  24.   VAR dta : searchrec;
  25.   BEGIN
  26.     get_cursor(DOScursor );
  27.     set_cursor(CURSOR_OFF);
  28.     WriteLn;
  29.     chdir('\'); LowVideo;
  30. {$IFDEF dir_recurse}
  31.    Write('':MAIN_MARGIN+Succ(Length(PROG_NAME)),
  32.          'Laufwerk ',start_path[1]);
  33.    findfirst('*.*',volumeid,dta);
  34.    WHILE (DOSerror = 0) AND
  35.          (dta.attr AND volumeid <> volumeid) DO
  36.      findnext(dta);
  37.    IF (dta.attr AND volumeid = volumeid)
  38.      THEN WriteLn(' trägt den Namen ',dta.name)
  39.      ELSE WriteLn(' trägt keinen Namen');
  40. {$ENDIF}
  41.    highvideo;
  42.    Write  ('':MAIN_MARGIN, PROG_NAME ); LowVideo;
  43.    WriteLn(PROG_JOB,start_path);
  44.    chdir(Copy(start_path,3,80));
  45.    WriteLn ;
  46.  END;
  47.  
  48. (* ------------------------------------------------------ *)
  49. (*   optical at the end of program                        *)
  50. PROCEDURE end_program;
  51.  
  52.   VAR l : STRING[3];
  53. BEGIN
  54.   highvideo;
  55.   WriteLn;     (* zuerst einen Report des Laufes zeigen *)
  56.   Write   ('':MAIN_MARGIN,PROG_NAME);
  57.   LowVideo;
  58.   Write   (' ... fertig');
  59.   IF dir_count > 1 THEN l := 'ies' ELSE l:= 'y';
  60.   IF is_echo THEN BEGIN
  61.     WriteLn (fil_count:15-Length(PROG_NAME),
  62.             ' Datei(en) gefunden.');
  63.     WriteLn ('':MAIN_MARGIN,   dir_count:24,
  64.             ' Director',l,' durchsucht.');
  65.     WriteLn ;
  66.     WriteLn ('':MAIN_MARGIN,disksize(0):24 ,
  67.            ' Byte gesamt auf Laufwerk ',start_path[1],':');
  68. {$IFDEF clean_recurse}
  69.     WriteLn ('':MAIN_MARGIN,old_diskmem:24 ,
  70.              ' Byte vorher frei.');
  71. {$ENDIF}
  72.     WriteLn ('':MAIN_MARGIN,  mem_count:24 ,
  73.              ' Byte in Datei(en) gefunden.');
  74.     WriteLn ('':MAIN_MARGIN,diskfree(0):24 ,' Byte ',
  75.              'jetzt frei.');
  76. {$IFDEF clean_recurse}
  77. {$ENDIF}
  78. (*   writeln ('':MAIN_MARGIN + length(PROG_NAME)+2,       *)
  79. (*   COPY_RIGHT);                                         *)
  80.     WriteLn;
  81.     LowVideo;
  82.   END;
  83.   chdir (start_path);  (* zurück zum Ursprungs-Directory *)
  84.   set_cursor (DOScursor);    (* DOS-Cursor wieder setzen *)
  85. END;
  86.  
  87. (* ------------------------------------------------------ *)
  88. PROCEDURE error_level (Line : textline);
  89.  
  90. BEGIN
  91.   highvideo;
  92.   Write(^G,'':FAIL_MARGIN,'FEHLER: '); LowVideo;
  93.   WriteLn(Line,' !');
  94.   WriteLn('':FAIL_MARGIN,' HILFE: ','PROG_NAME',
  95.           ' mit ''-?'' starten.');
  96. END;
  97.  
  98. (* ------------------------------------------------------ *)
  99. PROCEDURE analyze (var order : order_typ);
  100. VAR line : textline; i : byte;
  101.  
  102.   PROCEDURE analyze_options;
  103.   VAR k : byte;
  104.   BEGIN
  105.     for k := 2 to length(pattern[i]) do
  106.       case upcase(pattern[i][k]) of
  107.         '-' ,
  108.         '/' : (* default    := toggle_   *);
  109.         'R' : recursive    := not recursive;
  110.         'E' : is_echo      := not is_echo  ;
  111.    '0'..'9' : OUTPUT_DELAY := (ord(pattern[i][k])-48)*50;
  112.         '?' : order        := info_        ;
  113. {$IFDEF clean_recurse}
  114.         'T' : tmp_on       := not tmp_on   ;
  115.         'N' : norton_on    := not norton_on;
  116.         'B' : turbo_on     := not turbo_on ;
  117.         'O' : obj_on       := not obj_on   ;
  118.         'M' : map_on       := not map_on   ;
  119.         'U' : unit_on      := not unit_on  ;
  120. {$ELSE}
  121.         'T' : time_on      := not time_on  ;
  122.         'D' : date_on      := not date_on  ;
  123.         'S' : size_on      := not size_on  ;
  124.         'A' : attr_on      := not attr_on  ;
  125. {$ENDIF}
  126.          else order := param_;
  127.        end;
  128.      END;
  129.  
  130. BEGIN
  131.   order      := work_     ;
  132.   parameters := paramcount;
  133.   if parameters >  MAXPATTERN-6 then begin
  134.     parameters := MAXPATTERN-6;
  135.     highvideo;
  136.     writeln('WARNUNG: Das Maximum sind ',MAXPATTERN-6,
  137.             ' Pattern!');
  138.     writeln;
  139.     lowvideo;
  140.   end;
  141.   i := 1;
  142.   while (order = work_) and (i <= parameters) do begin
  143.     pattern[i] := paramstr(i);
  144.     if pattern[i][1] in ['-','/'] then begin
  145.       analyze_options;
  146.       pattern[i] := '';  END
  147.     ELSE IF Pattern[i] = '*.*' THEN order := pattern_;
  148.     inc(i);
  149.   END;
  150.   parameters := 0;
  151. {$IFDEF clean_recurse}
  152.   IF order = work_ THEN BEGIN
  153.     IF  tmp_on     THEN Pattern[20] := '*.TMP';
  154.     IF  norton_on  THEN Pattern[19] := '*.~* ';
  155.     IF  turbo_on   THEN Pattern[18] := '*.BAK';
  156.     IF  obj_on     THEN Pattern[17] := '*.OBJ';
  157.     IF  map_on     THEN Pattern[16] := '*.TPM';
  158.     IF  unit_on    THEN Pattern[15] := '*.TPU';
  159.   END;
  160.   FOR i := 1 TO MAXPATTERN DO
  161.     IF Pattern[i] <> '' THEN inc(parameters);
  162.   IF parameters = 0 THEN order := missing_;
  163. {$ELSE}
  164.   FOR i := 1 TO MAXPATTERN DO
  165.     IF Pattern[i] <> '' THEN inc(parameters);
  166.   IF parameters = 0 THEN Pattern[1] := '*.*';
  167.   is_echo := TRUE;
  168. {$ENDIF}
  169. END;
  170.  
  171. (* ------------------------------------------------------ *)
  172. (*                    Main                                *)
  173. VAR order : order_typ;
  174.        (* gibt Status / nächstes anzusteuerndes Modul an  *)
  175. BEGIN
  176.   checkbreak  := FALSE;
  177.         (* wird zu CTRL-C und damit von wait() abgefangen *)
  178.   old_diskmem := diskfree(0);
  179.   getdir(0,start_path);
  180.   start_program;
  181.   analyze (order);
  182.   CASE order OF
  183. {$IFDEF clean_recurse}
  184.     pattern_   : error_level
  185.                ('ZUGRIFF VERWEIGERT wegen Pattern ''*.*''');
  186. {$ELSE}
  187.       pattern_ ,
  188. {$ENDIF}
  189.       work_    : BEGIN
  190.                    subdir     := start_path;
  191.                    recurse (0);
  192.                    end_program;
  193.                  END;
  194.       info_    : error_level ('Keine HILFE verfügbar');
  195.       param_   : error_level ('Unbekannte Option');
  196.       missing_ : error_level ('Kein Pattern angegeben');
  197.   ELSE           error_level ('Undefinierte Störung');
  198.   END;
  199. END.
  200. (* ------------------------------------------------------ *)
  201. (*                 Ende von RECURSE.PAS                   *)
  202.