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.