home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / tricks / compdel.pas < prev    next >
Pascal/Delphi Source File  |  1989-11-07  |  5KB  |  174 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    COMPDEL.PAS                         *)
  3. (*        (C) 1989  Richard Rattey & TOOLBOX              *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM CompDel;
  6. {$R-,S-,I+,D+,F-,V-,B-,N-,L+}
  7. {$M 16384,0,255000}
  8.  
  9. USES Dos, Crt;
  10.  
  11. TYPE
  12.   Str80 = STRING[80];
  13.   Str12 = STRING[12];
  14.  
  15. VAR
  16.   teilpfad1, pfad1, pfad2 : Str80;
  17.   geloescht               : WORD;
  18.  
  19.   PROCEDURE Fehler;
  20.   BEGIN
  21.     WriteLn(#13,#10,'              "COMPDEL" - ',
  22.                     'Erklärungen:    ');
  23.     WriteLn('    Format: compdel  Quelldateien  ',
  24.             'Zielverzeichnis');
  25.     WriteLn('      Beispiel: compdel  a:\*.*  ',
  26.             'c:\WORD\texte\');
  27.     WriteLn('Quellverzeichnis und Zielverzeichnis ',
  28.             'müssen verschieden sein.');
  29.     Halt;
  30.   END;
  31.  
  32.   PROCEDURE Ziel(VAR name : Str12);
  33.   VAR
  34.     lschdat  : FILE;
  35.     lschname : Str80;
  36.     zeile    : BYTE;
  37.     fnr      : INTEGER;
  38.     Regs     : Registers;
  39.   BEGIN
  40.     Write(teilpfad1, name);
  41.     lschname := pfad2 + name;
  42.     Assign(lschdat, lschname);
  43.     zeile := WhereY;
  44.     GotoXY(32, zeile);
  45.     Write(lschname);
  46.     GotoXY(48 + length(pfad2), zeile);
  47.     {$I-}
  48.     Erase(lschdat);
  49.     {$I+}
  50.     fnr := IOResult;
  51.     CASE fnr OF
  52.        0 : BEGIN
  53.              WriteLn('wird gelöscht');
  54.              geloescht := Succ(geloescht);
  55.            END;
  56.        2 : WriteLn('nicht gefunden');
  57.        5 : WriteLn('Zugriff verweigert');
  58.      150 : BEGIN
  59.              WriteLn(#13,#10,'Schreibschutzfehler im ',
  60.                              'Ziellaufwerk');
  61.              Regs.ah := 13;              { Disketten Reset }
  62.              Msdos(Regs);            { nach Hardwarefehler }
  63.              Halt;
  64.            END;
  65.      152 : BEGIN
  66.              WriteLn(#13,#10,'Laufwerk nicht bereit');
  67.              Halt;
  68.            END;
  69.     ELSE
  70.       Writeln(#13, #10, 'Anderer Fehler - Nr: ', fnr);
  71.       Regs.ah := 13;                     { Disketten Reset }
  72.       Msdos(Regs);                   { nach Hardwarefehler }
  73.       Halt;
  74.     END;
  75.   END;
  76.  
  77.   PROCEDURE Quelle;
  78.   VAR
  79.     dat        : SearchRec;
  80.     namenfeld  : ARRAY[1..1024] OF STR12;
  81.                                     { Maximal 1024 Dateien }
  82.     zaehler, i : WORD;               { im Quellverzeichnis }
  83.   BEGIN
  84.     zaehler := 1;
  85.     FindFirst(pfad1, $20, dat);
  86.     IF DosError = 0 THEN
  87.       REPEAT
  88.         namenfeld[zaehler] := (dat.name);
  89.         FindNext(dat);
  90.         zaehler := Succ(zaehler);
  91.       UNTIL (doserror <> 0) OR (zaehler = 1025);
  92.     zaehler := Pred(zaehler);
  93.     FOR i := 1 TO zaehler DO ziel(namenfeld[i]);
  94.   END;
  95.  
  96.   FUNCTION Gross(t : Str80) : Str80;
  97.   VAR
  98.     i : INTEGER;
  99.     u : Str80;
  100.   BEGIN
  101.     u := '';
  102.     FOR i := 1 TO Length(t) DO
  103.       CASE t[i] OF
  104.         'ä' : u := u + 'Ä';
  105.         'ö' : u := u + 'Ö';
  106.         'ü' : u := u + 'Ü';
  107.       ELSE
  108.         u := u + UpCase(t[i]);
  109.       END;
  110.     gross := u;
  111.   END;
  112.  
  113.   PROCEDURE ParameterPruef;
  114.   VAR
  115.     stelle1, stelle2  : WORD;
  116.     pfadakt, pfadteil : STR80;
  117.                    lw : STRING[2];
  118.   BEGIN
  119.     pfad1 := gross(pfad1);
  120.     pfad2 := gross(pfad2);
  121.     IF pfad2[Length(pfad2)] <> '\' THEN
  122.       pfad2 := pfad2 + '\';
  123.     GetDir(0, pfadakt);
  124.        { Aktuellen Pfad holen, um ev.Parameter zu ergänzen }
  125.     lw := Copy(pfadakt, 1, 2);
  126.     IF Copy(pfad1, 2, 1) <> ':' THEN
  127.                       { Quellpfad analysieren und ergänzen }
  128.       IF pfad1[1]<>'\' THEN
  129.         IF pfadakt[Length(pfadakt)] = '\' THEN
  130.           pfad1 := pfadakt + pfad1
  131.         ELSE
  132.           pfad1 := pfadakt + '\' + pfad1
  133.       ELSE
  134.         pfad1 := lw+pfad1
  135.     ELSE
  136.       IF Copy(pfad1,3,1) <> '\' THEN Insert('\',pfad1,3);
  137.     IF Copy(pfad2,2,1) <> ':' THEN BEGIN
  138.                        { Zielpfad analysieren und ergänzen }
  139.       IF pfad2[1] <> '\' THEN pfad2 := '\' + pfad2;
  140.       pfad2 := lw + pfad2;
  141.     END ELSE
  142.       IF Copy(pfad2,3,1) <> '\' THEN Insert('\', pfad2,3);
  143.     stelle2  := 0;
  144.     stelle1  := 0;
  145.     pfadteil := pfad1;
  146.     REPEAT              { Quellpfad von Dateinamen trennen }
  147.       stelle1 := stelle1 + stelle2;
  148.       pfadteil := Copy(pfadteil, Succ(stelle2),
  149.                        Length(pfadteil));
  150.       stelle2 := Pos('\', pfadteil);
  151.     UNTIL stelle2 = 0;
  152.     teilpfad1 := Copy(pfad1, 1, stelle1);
  153.     IF teilpfad1 = pfad2 THEN BEGIN
  154.                 { Quell- und Zielpfad auf Identität prüfen }
  155.       WriteLn('      Fehler: Quell- und Zielverzeichnis ',
  156.               'sind identisch!');
  157.       Fehler;
  158.     END;
  159.   END;
  160.  
  161. BEGIN
  162.   IF ParamCount <> 2 THEN BEGIN
  163.     WriteLn('Ungültige Parameteranzahl !');
  164.     Fehler;
  165.   END;
  166.   pfad1 := ParamStr(1);
  167.   pfad2 := ParamStr(2);
  168.   ParameterPruef;
  169.   geloescht := 0;
  170.   Quelle;
  171.   WriteLn('  Es wurden ', geloescht, ' Dateien gelöscht.');
  172. END.
  173. (* ------------------------------------------------------ *)
  174. (*                 Ende von COMPDEL.PAS                   *)