home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
02
/
tricks
/
compdel.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-11-07
|
5KB
|
174 lines
(* ------------------------------------------------------ *)
(* COMPDEL.PAS *)
(* (C) 1989 Richard Rattey & TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM CompDel;
{$R-,S-,I+,D+,F-,V-,B-,N-,L+}
{$M 16384,0,255000}
USES Dos, Crt;
TYPE
Str80 = STRING[80];
Str12 = STRING[12];
VAR
teilpfad1, pfad1, pfad2 : Str80;
geloescht : WORD;
PROCEDURE Fehler;
BEGIN
WriteLn(#13,#10,' "COMPDEL" - ',
'Erklärungen: ');
WriteLn(' Format: compdel Quelldateien ',
'Zielverzeichnis');
WriteLn(' Beispiel: compdel a:\*.* ',
'c:\WORD\texte\');
WriteLn('Quellverzeichnis und Zielverzeichnis ',
'müssen verschieden sein.');
Halt;
END;
PROCEDURE Ziel(VAR name : Str12);
VAR
lschdat : FILE;
lschname : Str80;
zeile : BYTE;
fnr : INTEGER;
Regs : Registers;
BEGIN
Write(teilpfad1, name);
lschname := pfad2 + name;
Assign(lschdat, lschname);
zeile := WhereY;
GotoXY(32, zeile);
Write(lschname);
GotoXY(48 + length(pfad2), zeile);
{$I-}
Erase(lschdat);
{$I+}
fnr := IOResult;
CASE fnr OF
0 : BEGIN
WriteLn('wird gelöscht');
geloescht := Succ(geloescht);
END;
2 : WriteLn('nicht gefunden');
5 : WriteLn('Zugriff verweigert');
150 : BEGIN
WriteLn(#13,#10,'Schreibschutzfehler im ',
'Ziellaufwerk');
Regs.ah := 13; { Disketten Reset }
Msdos(Regs); { nach Hardwarefehler }
Halt;
END;
152 : BEGIN
WriteLn(#13,#10,'Laufwerk nicht bereit');
Halt;
END;
ELSE
Writeln(#13, #10, 'Anderer Fehler - Nr: ', fnr);
Regs.ah := 13; { Disketten Reset }
Msdos(Regs); { nach Hardwarefehler }
Halt;
END;
END;
PROCEDURE Quelle;
VAR
dat : SearchRec;
namenfeld : ARRAY[1..1024] OF STR12;
{ Maximal 1024 Dateien }
zaehler, i : WORD; { im Quellverzeichnis }
BEGIN
zaehler := 1;
FindFirst(pfad1, $20, dat);
IF DosError = 0 THEN
REPEAT
namenfeld[zaehler] := (dat.name);
FindNext(dat);
zaehler := Succ(zaehler);
UNTIL (doserror <> 0) OR (zaehler = 1025);
zaehler := Pred(zaehler);
FOR i := 1 TO zaehler DO ziel(namenfeld[i]);
END;
FUNCTION Gross(t : Str80) : Str80;
VAR
i : INTEGER;
u : Str80;
BEGIN
u := '';
FOR i := 1 TO Length(t) DO
CASE t[i] OF
'ä' : u := u + 'Ä';
'ö' : u := u + 'Ö';
'ü' : u := u + 'Ü';
ELSE
u := u + UpCase(t[i]);
END;
gross := u;
END;
PROCEDURE ParameterPruef;
VAR
stelle1, stelle2 : WORD;
pfadakt, pfadteil : STR80;
lw : STRING[2];
BEGIN
pfad1 := gross(pfad1);
pfad2 := gross(pfad2);
IF pfad2[Length(pfad2)] <> '\' THEN
pfad2 := pfad2 + '\';
GetDir(0, pfadakt);
{ Aktuellen Pfad holen, um ev.Parameter zu ergänzen }
lw := Copy(pfadakt, 1, 2);
IF Copy(pfad1, 2, 1) <> ':' THEN
{ Quellpfad analysieren und ergänzen }
IF pfad1[1]<>'\' THEN
IF pfadakt[Length(pfadakt)] = '\' THEN
pfad1 := pfadakt + pfad1
ELSE
pfad1 := pfadakt + '\' + pfad1
ELSE
pfad1 := lw+pfad1
ELSE
IF Copy(pfad1,3,1) <> '\' THEN Insert('\',pfad1,3);
IF Copy(pfad2,2,1) <> ':' THEN BEGIN
{ Zielpfad analysieren und ergänzen }
IF pfad2[1] <> '\' THEN pfad2 := '\' + pfad2;
pfad2 := lw + pfad2;
END ELSE
IF Copy(pfad2,3,1) <> '\' THEN Insert('\', pfad2,3);
stelle2 := 0;
stelle1 := 0;
pfadteil := pfad1;
REPEAT { Quellpfad von Dateinamen trennen }
stelle1 := stelle1 + stelle2;
pfadteil := Copy(pfadteil, Succ(stelle2),
Length(pfadteil));
stelle2 := Pos('\', pfadteil);
UNTIL stelle2 = 0;
teilpfad1 := Copy(pfad1, 1, stelle1);
IF teilpfad1 = pfad2 THEN BEGIN
{ Quell- und Zielpfad auf Identität prüfen }
WriteLn(' Fehler: Quell- und Zielverzeichnis ',
'sind identisch!');
Fehler;
END;
END;
BEGIN
IF ParamCount <> 2 THEN BEGIN
WriteLn('Ungültige Parameteranzahl !');
Fehler;
END;
pfad1 := ParamStr(1);
pfad2 := ParamStr(2);
ParameterPruef;
geloescht := 0;
Quelle;
WriteLn(' Es wurden ', geloescht, ' Dateien gelöscht.');
END.
(* ------------------------------------------------------ *)
(* Ende von COMPDEL.PAS *)