oblit.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
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.