home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 06_07 / trick / eraser.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-28  |  4.3 KB  |  181 lines
  1. (* ------------------------------------------------- *)
  2. (*                  ERASER.PAS                       *)
  3. {$D+}
  4. PROGRAM Eraser;
  5.  
  6. TYPE strmax = string[255];
  7.      str20  = string[20];
  8.  
  9. VAR datnam :array[1..64] of string[13];
  10.     eingmaske :strmax;
  11.     ende,selekt :char;
  12.     anzdat :integer;
  13.  
  14. {$I WILDCARD.INC }
  15.  
  16. FUNCTION StrUp(s :strmax) :strmax;
  17.  
  18. VAR ch :char;
  19.     sh :strmax;
  20.     i :byte;
  21.  
  22. BEGIN
  23.   sh:='';
  24.   FOR i:=1 TO length(s) DO BEGIN
  25.     ch:=upcase(s[i]);
  26.     sh:=sh+ch;
  27.   END;
  28.   StrUp:=sh;
  29. END;
  30.  
  31.  
  32. PROCEDURE Dir(maske :str20; breite :integer);
  33.  
  34. VAR fcb :array[0..25] of byte absolute $005C;
  35.     dma :array[0..255] of byte;
  36.     anf,fehler,anzausgdat,i,j :integer;
  37.     str :string[13];
  38.  
  39.   PROCEDURE CharOver(index,pos :integer; ch :char);
  40.  
  41.   BEGIN
  42.     insert(ch,datnam[index],pos);
  43.     delete(datnam[index],pos+1,1);
  44.   END;
  45.  
  46. BEGIN
  47.   { ** Directory einlesen ** }
  48.   FOR i:=1 TO 64 DO
  49.     datnam[i]:='         .   ';
  50.   anzdat:=1;
  51.   fehler:=bdos($1A,addr(dma));
  52.   fcb[0]:=0;
  53.   FOR i:=1 TO 11 DO
  54.     fcb[i]:=ord('?');
  55.   fehler:=bdos($11,addr(fcb));
  56.   IF fehler<>255 THEN BEGIN
  57.     anf:=fehler*32;
  58.     FOR i:=anf TO anf+8 DO
  59.       CharOver(anzdat,i-anf+1,chr(mem[addr(dma)+i]));
  60.       FOR i:=anf+9 TO anf+12 DO
  61.         CharOver(anzdat,i-anf+2,chr(mem[addr(dma)+i]));
  62.   END;
  63.   REPEAT
  64.     anzdat:=anzdat+1;
  65.     fehler:=bdos($12);
  66.     anf:=fehler*32;
  67.     IF fehler<>255 THEN BEGIN
  68.       FOR i:=anf TO anf+8 DO
  69.         CharOver(anzdat,i-anf+1,chr(mem[addr(dma)+i]));
  70.       FOR i:=anf+9 TO anf+12 DO
  71.         CharOver(anzdat,i-anf+2,chr(mem[addr(dma)+i]));
  72.     END;
  73.   UNTIL fehler=255;
  74.   anzdat:=anzdat-1;
  75.  
  76.   { ** Dateinamen sortieren ** }
  77.   FOR i:=1 TO anzdat-1 DO
  78.     FOR j:=i+1 TO anzdat DO
  79.       IF datnam[i]>datnam[j] THEN BEGIN
  80.         str:=datnam[i];
  81.         datnam[i]:=datnam[j];
  82.         datnam[j]:=str;
  83.       END;
  84.  
  85.   { ** Dateinamen ausgeben ** }
  86.   anzausgdat:=0;
  87.   IF maske='*.*' THEN BEGIN
  88.     FOR i:=1 TO anzdat DO BEGIN
  89.       write(datnam[i],'   ');
  90.       IF (i mod breite)=0 THEN writeln;
  91.     END;
  92.     anzausgdat:=i; END
  93.   ELSE BEGIN
  94.     FOR i:=1 TO anzdat DO BEGIN
  95.       str:=datnam[i];
  96.       j:=pos(' ',str);
  97.       IF j>0 THEN delete(str,j,10-j);
  98.       delete(str,1,1);
  99.       IF Wildcard(maske,str,'*','?')=true THEN BEGIN
  100.         write(datnam[i],'   ');
  101.         anzausgdat:=anzausgdat+1;
  102.         IF (anzausgdat mod breite)=0 THEN writeln;
  103.       END;
  104.     END;
  105.   END;
  106.   IF (anzausgdat mod breite)>0 THEN writeln;
  107.   writeln;
  108.   writeln(anzausgdat,' Dateien von ',anzdat,' Dateien');
  109. END;
  110.  
  111.  
  112. PROCEDURE EraseDat(maske :str20);
  113.  
  114. VAR str :string[13];
  115.     loeschen :char;
  116.     i,j,anzeradat :integer;
  117.     dat :file of byte;
  118.  
  119. BEGIN
  120.   anzeradat:=0;
  121.   FOR i:=1 TO anzdat DO BEGIN
  122.     str:=datnam[i];
  123.     j:=pos(' ',str);
  124.     IF j>0 THEN delete(str,j,10-j);
  125.     delete(str,1,1);
  126.     IF Wildcard(maske,str,'*','?')=true THEN BEGIN
  127.       write(datnam[i],'   ');
  128.       IF selekt='J' THEN BEGIN
  129.         write('  J/N ? ');
  130.         read(kbd,loeschen);
  131.         loeschen:=upcase(loeschen);
  132.         write(#8,#8,#8,#8,#8,#8);
  133.         IF loeschen='J' THEN writeln('J ***')
  134.         ELSE writeln('N    '); END
  135.     ELSE
  136.       writeln;
  137.       IF ((selekt='J') and (loeschen='J'))
  138.                        or (selekt='N') THEN BEGIN
  139.         assign(dat,str);
  140.         erase(dat);
  141.         anzeradat:=anzeradat+1;
  142.       END;
  143.     END;
  144.   END;
  145.   writeln;
  146.   writeln(anzeradat,' Dateien von ',anzdat,
  147.           ' Dateien geloescht');
  148. END;
  149.  
  150.  
  151. BEGIN
  152.   writeln('===================== ERASER ============',
  153.           '==========');
  154.   REPEAT
  155.     writeln;
  156.     writeln('nur ENTER: alle Dateien');
  157.     write('Dir-Maske: ');
  158.     readln(eingmaske);
  159.     eingmaske:=StrUp(eingmaske);
  160.     IF eingmaske='' THEN eingmaske:='*.*';
  161.     Dir(eingmaske,5);
  162.     writeln;
  163.     writeln('nur ENTER: keine Datei');
  164.     write('Erase-Maske: ');
  165.     readln(eingmaske);
  166.     eingmaske:=StrUp(eingmaske);
  167.     IF eingmaske<>'' THEN BEGIN
  168.       write('selektiertes Loeschen (J/N)? ');
  169.       read(kbd,selekt);
  170.       writeln;
  171.       selekt:=upcase(selekt);
  172.       EraseDat(eingmaske);
  173.     END;
  174.     writeln;
  175.     write('ERASER beenden (J/N)? ');
  176.     read(kbd,ende);
  177.     writeln;
  178.   UNTIL upcase(ende)='J';
  179. END.
  180. (* ------------------------------------------------- *)
  181. (*                Ende von ERASER.PAS                *)