home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
KEEP.ZIP
/
MASSDEL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-19
|
9KB
|
375 lines
program massDel;
{-----------------------------------------------------------------------------
- -
- MASSDEL.PAS -
- -
- Author: Rick Owen -
- Date : 12/17/91 -
- Massdel: -
- 1) parses the command line for file names (or file specs) -
- 2) deletes all files which match the specification(s) -
- These programs carry no warranties either expressed or implied. I -
- assume no liability of any kind [use at YOUR risk]. Any program -
- which deletes files is inherently dangerous and you should be -
- extremely careful when using either KEEP or MASSDEL. You are free to -
- use both programs however you wish, and you may freely distribute -
- copies of either program, as long as you do not charge for it [connect -
- charges to BBSes are excluded from this restriction]. -
-----------------------------------------------------------------------------}
uses dos, crt;
const
MAXPARMS = 50;
ReadOnly = $01;
Hidden = $02;
SysFile = $04;
VolumeID = $08;
Directory = $10;
Archive = $20;
DEBUG = false;
type
parmList = array[1..MAXPARMS] of String[12];
var
fileParms : parmList;
confirm : boolean;
silent : boolean;
fileCount : word;
parmCount : word;
procedure help;
begin { help }
writeln('massDel v1.0 - delete all files specified.');
writeln('usage: massDel [-d] [-s] filespec1 [filespec2 ... filespecN]');
writeln(' -d = dangerous mode (no confirm)');
writeln(' -s = silent mode (no report as files are deleted)');
writeln(' defaults : confirm and not silent');
writeln;
writeln('massDel was written in Turbo Pascal V6.0 by Rick Owen');
writeln('Revision level = 0, Release date = 12/18/91.');
halt(1);
end { help };
procedure miniHelp;
begin { miniHelp }
writeln;
writeln(' y - yes, delete file');
writeln(' n - no, do not delete file');
writeln(' q - no, do not delete file and terminate the program');
writeln(' c - yes, delete file and continue without further confirmation');
writeln(' l - list remaining files which will be deleted');
writeln;
end; {miniHelp }
procedure getParameters;
var
parmLoop : Word;
parm : string[1];
begin { getParameters }
if (ParamCount < 0) or (ParamCount > MAXPARMS) then
begin
help; { we don't return from help }
end
else
begin
confirm := true;
silent := false;
parmCount := 1;
for parmLoop := 1 to ParamCount do
begin
if copy(ParamStr(parmLoop),1,1) = '-' then
begin
{ this is a parameter }
parm := copy(ParamStr(parmLoop),2,1);
if ((parm = 's') or (parm = 'S')) then
silent := true;
if ((parm = 'd') or (parm = 'D')) then
confirm := false;
if (pos(parm,'sSdD') = 0) then
begin
write('Unknown parameter - ignored');
writeln;
end
end
else
begin
fileParms[parmCount] := ParamStr(parmLoop);
inc(parmCount);
end
end; { loop }
dec(parmCount);
if parmCount = 0 then
help;
end; { for }
end; { getParameters }
function LeadingZero(w : Word) : String;
var
s : String;
begin { LeadingZero }
Str(w:0,s);
if Length(s) = 1 then
s := '0' + s;
LeadingZero := s;
end; { LeadingZero }
procedure writeFileData( dta : SearchRec );
var
dt : DateTime;
begin { writeFileData }
write(dta.name:12);
write(dta.size:8);
write(' ');
UnpackTime(dta.time,dt);
with dt do
begin
Write(' ',LeadingZero(day), '/',LeadingZero(month),'/',
LeadingZero(year));
Write(' ', LeadingZero(hour),':',
LeadingZero(min),':', LeadingZero(sec));
Write(' ');
end;
end; { writeFileData }
procedure listRemainingFiles( dta : SearchRec;
whichParm : word;
fileParms : parmList );
var
t : SearchRec;
lineCount : word;
ch : Char;
parmLoop : word;
begin { listRemainingFiles }
parmLoop := whichParm;
DosError := 0;
writeln;
lineCount := 2;
writeln('───────────── Start of List ─────────────');
For parmLoop := whichParm to parmCount do
begin
if parmLoop = whichParm then
begin
move(dta, t, SizeOf(t));
end
else
begin
findfirst(fileParms[parmLoop], Archive, t);
end;
while DosError = 0 do
begin
writeFileData( t );
writeln;
inc(lineCount);
if lineCount > 24 then
begin
write('───────── pausing - press a key ─────────');
ch := readKey;
if ch = #27 then
begin
writeln;
exit;
end;
writeln;
lineCount := 1;
end;
findNext( t );
end; { while }
end;
writeln('────────────── End of List ──────────────');
end; { listRemainingFiles }
procedure writePrompt;
begin { writePrompt }
Write(' : delete (y/N/q/c/l/?) ');
end; { writePrompt }
procedure deleteTheFiles;
var
fileLoop : Word;
dta : SearchRec;
listDta : SearchRec;
dt : DateTime;
confirmKey : char;
doExit : boolean;
doStop : boolean;
deleteIt : boolean;
f : file;
debugLoop : word;
begin { deleteTheFiles }
fileCount := 1;
deleteIt := true;
doExit := false;
doStop := false;
for fileLoop := 1 to parmCount do
begin
if (DEBUG) then
begin
writeln('searching for ',fileParms[fileLoop]);
end;
findfirst(fileParms[fileLoop], Archive, dta);
if (DEBUG) then
begin
writeln('after FindFirst DosError = ',DosError:3);
end;
while DosError = 0 do
begin
if confirm then
begin
writeFileData( dta );
writePrompt;
repeat
confirmKey := upcase(readkey);
case confirmKey of
'Y' : begin
deleteIt := true;
doExit := true
end;
'N',#13 : begin
doExit := true;
deleteIt := false;
end;
'Q',#27 : begin
doExit := true;
doStop := true;
end;
'L' : begin
listRemainingFiles( dta, fileLoop, fileParms );
writeFileData( dta );
writePrompt;
end;
'C' : begin
doExit := true;
deleteIt := true;
confirm := false
end;
'?' : begin
miniHelp;
writeFileData( dta );
writePrompt;
end;
else doExit := false;
end; { case }
until doExit;
writeln;
end;
if doStop then
begin
halt(5);
end;
if deleteIt then
begin
Assign(f, dta.name);
{$I-}
Reset(f);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Cannot find ', dta.name);
halt(6);
end
else
begin
Close(f);
if not silent then
writeln(' deleting ', dta.name);
Erase(f);
end;
end;
if (DEBUG) then
begin
write('searching for next ');
for debugLoop := 1 to 21 do
begin
if (dta.fill[debugLoop] > 31) and (dta.fill[debugLoop] < 127) then
write(chr(dta.fill[debugLoop]))
else
write('~');
end; { for }
writeln;
end;
findnext(dta);
if (DEBUG) then
begin
writeln('after FindNext DosError = ',DosError:3);
end;
end; { while }
end; { for }
end; { deleteTheFiles }
begin { massDel }
CheckBreak := false;
getParameters;
deleteTheFiles;
end { massDel }.