Tools en Utilities/CDASS_5.ISO/shell/file/dele.arj/D.PAS

Pascal/Delphi Source File | 1993-04-03 | 4.6 KB | 228 lines

program destroy_;

{compiled with Borland Turbo Pascal 7.0 for DOS}

{$N-,I-,B+,S+}

uses crt,dos,drivers;

var
reply : string;
placeholder : char;
destroy : file of byte; { needed only to use the FileSize procedure,
                          which will not work on text files. In case the
                          sensitive file you need to destroy happens to be
                          a text file. }
destroyed : text;
filesize1, filesize2, percentage : real;
count : shortint;
on_off : boolean;

label tryagain,done;

begin
initsyserror;
tryagain:
count := 0;
reset(input);
textcolor(15);
textbackground(0);
clrscr;
textcolor(13);
textbackground(0);
writeln;
writeln;
textcolor(7);
writeln('  Be sure you want to continue, this program deletes a file forever.');
writeln('  Pathnames are fine if you need to put one. Enter a semicolon to exit.');
writeln('  Wildcards not allowed. You may only destroy one file at a time.');
textcolor(13);
writeln;
writeln;
write('  Name your victim');
textcolor(141);
write(' ───>  ');
textcolor(15);
if not eoln(input) then
begin
donesyserror;
readln (reply);
if reply = ';' then goto done;
assign(destroy, reply);
reset(destroy);
if ioresult <> 0 then
begin
initsyserror;
textcolor(15);
clrscr;
textcolor(12);
reset(input);
gotoxy(2,12);
write('I can''t find or use this file: "');
textcolor(11);
write(reply);
textcolor(12);
writeln('"');
write(' ...maybe it''s read-only. Press Enter... ');
textcolor(15);
if not eoln(input) then
readln(placeholder)
else goto tryagain;
goto tryagain;
end;
end
else goto tryagain;
initsyserror;
filesize1 := filesize(destroy);
filesize2 := 0;
close (destroy);
erase (destroy);
assign (destroyed, reply);  { switch-a-roo the files in the F.A.T. }
rewrite(destroyed);
textcolor(11);
writeln;
writeln;
writeln('  Working... on slower computers and/or larger files this could take a while...');
writeln;
textcolor(14);
textbackground(1);
gotoxy(42,13);
write('      ');
gotoxy(30,13);
write('          ');
gotoxy(30,13);
while filesize2 < filesize1 do
begin
writeln(destroyed, '10101010101010101010101010101 "Yes fan" was here 010101010101010101010101010101');
filesize2 := filesize2 + 81;
percentage := filesize2/filesize1;
while (percentage > 0.1) and (count < 1) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('10% ');
gotoxy(31,13);
end;
while (percentage > 0.2) and (count < 2) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('20% ');
gotoxy(32,13);
end;
while (percentage > 0.3) and (count < 3) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('30% ');
gotoxy(33,13);
end;
while (percentage > 0.4) and (count < 4) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('40% ');
gotoxy(34,13);
end;
while (percentage > 0.5) and (count < 5) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('50% ');
gotoxy(35,13);
end;
while (percentage > 0.6) and (count < 6) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('60% ');
gotoxy(36,13);
end;
while (percentage > 0.7) and (count < 7) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('70% ');
gotoxy(37,13);
end;
while (percentage > 0.8) and (count < 8) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('80% ');
gotoxy(38,13);
end;
while (percentage > 0.9) and (count < 9) do
begin
write('▒');
count := count + 1;
gotoxy(43,13);
write('90% ');
gotoxy(39,13);
end;
end;
write('▒');
gotoxy(43,13);
writeln('100% ');
close (destroyed);
erase (destroyed); { now "reply" is a text file with garbage in it. And it's
                     at least as long as the original, possibly longer by
                     up to 81 bytes. }
writeln;
writeln;
textcolor(14);
textbackground(0);
write('  Done');
textcolor(142);
write('!');
textcolor(14);
write('  Enter a semicolon to quit or press Enter to continue....');
textcolor(15);
textbackground(1);
write('   ');
reset(input);
gotoxy(67,16);
if not eoln(input) then
begin
donesyserror;
readln(placeholder);
if placeholder = ';' then
goto done
else
goto tryagain;
end
else goto tryagain;
done:
textcolor(7);
textbackground(0);
clrscr;
textcolor(11);
writeln;
writeln;
write(' "');
textcolor(9);
write('Yes fan');
textcolor(11);
write('"');
textcolor(9);
writeln(' was here...');
textcolor(13);
writeln;
writeln(' If it works for you, a 2 or 3 dollar contribution would be very welcome...');
textcolor(10);
writeln;
writeln(' Duane Bailey');
writeln(' 409 W. First St, Apt. C');
writeln(' Winston-Salem, NC 27101');
textcolor(7);
writeln;
end.