85 lines
1.9 KiB
ObjectPascal
85 lines
1.9 KiB
ObjectPascal
uses crt,dos,
|
|
myio;
|
|
|
|
var b:array[1..16384] of byte;
|
|
c:char;
|
|
|
|
procedure obliterate(s:string);
|
|
var f:file;
|
|
siz,siz1:longint;
|
|
i:integer;
|
|
c:char;
|
|
begin
|
|
assign(f,s); reset(f,1);
|
|
siz:=filesize(f); siz1:=((siz-1) div 16384);
|
|
|
|
textcolor(12); write('"'+s+'": ');
|
|
textcolor(4); write('®');
|
|
textcolor(14); for i:=1 to siz1+1 do write('ù');
|
|
textcolor(4); write('¯');
|
|
for i:=1 to siz1+2 do write(^H);
|
|
|
|
textcolor(14);
|
|
for i:=0 to siz1 do begin blockwrite(f,b,16384); write('*'); end;
|
|
close(f);
|
|
|
|
gotoxy(wherex+1,wherey);
|
|
textcolor(4); write(' - Obliterated. Delete? ');
|
|
repeat c:=upcase(readkey) until (c in ['Y','N']);
|
|
gotoxy(wherex-8,wherey); write(' '); gotoxy(wherex-8,wherey);
|
|
if (c='Y') then begin
|
|
erase(f);
|
|
write('Deleted.');
|
|
end;
|
|
writeln;
|
|
end;
|
|
|
|
procedure obliterate1(s:string);
|
|
var dirinfo:searchrec;
|
|
begin
|
|
findfirst(s,anyfile-directory,dirinfo);
|
|
while (doserror=0) do begin
|
|
obliterate(dirinfo.name);
|
|
findnext(dirinfo);
|
|
end;
|
|
writeln;
|
|
cwrite(#3#9+'þ '+#3#11+'Obliteration complete');
|
|
writeln;
|
|
writeln;
|
|
end;
|
|
|
|
procedure init;
|
|
var i:integer;
|
|
begin
|
|
for i:=1 to 16384 do b[i]:=1;
|
|
end;
|
|
|
|
begin
|
|
writeln;
|
|
cwrite(#2#0+#3#14+'OBLIT '+#3#7+'- '+#3#11+'Aug 20 1989'+#3#7+' - '+
|
|
#3#11+'Total File Obliteration');
|
|
writeln;
|
|
cwrite(#3#11+'Written by Eric Oman '+#3#7+'- '+
|
|
#3#4+'The '+#3#15+'Pointe '+#3#9+'BBS '+#3#7+'- '+
|
|
#3#11+'313-885-1779 '+#3#7+'- '+
|
|
#3#11+'1200/2400');
|
|
writeln;
|
|
writeln;
|
|
if (paramcount=1) then begin
|
|
cwrite(#3#9+'þ '+#3#11+'Obliterate: "'+paramstr(1)+'"'); writeln;
|
|
cwrite(#3#4+' Confirm? '+#3#11);
|
|
repeat c:=upcase(readkey) until (c in ['Y','N']);
|
|
if (c='Y') then write('Yes') else write('No');
|
|
writeln;
|
|
if (c='Y') then begin
|
|
writeln;
|
|
init;
|
|
obliterate1(paramstr(1));
|
|
end;
|
|
end else begin
|
|
cwrite(#3#9+'þ '+#3#11+'Invalid parameters.');
|
|
writeln;
|
|
halt(1);
|
|
end;
|
|
end.
|