Протестите программу для безвозвратного удаления информации

program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils;

type st=^string;
buffer=array[1..1024*4] of byte;
var
f:file of buffer;
m,er:integer;
tmp:buffer;
n:longword;
way,wh,key:st;
time,msg:string;
const s=1024*4;

procedure wtime;
begin
time:=TimeToStr(gettime);
writeln;
write(' start = ',msg,time);
end;

procedure init(var n:longword);
begin
writeln; msg:='Read file :';wtime;
assign(f,way^);
reset(f);
n:=0;
while not eof(f) do begin
blockread(f,tmp,1);
inc(n);
end;
writeln('  ok');
close(f);
end;

procedure fill(b,m:byte;var tmp:buffer);
var j:word;
begin
case m of 1:for j:=1 to s do tmp[j]:=b;
          2:for j:=1 to s do tmp[j]:=random(255);
          end
end;

procedure nop(way:st);
{Процедура заливки нулями}
var tmp:buffer;
i:longword;
begin
writeln(' Start nops wipe');
init(n);
fill(0,1,tmp);
rewrite(f); writeln;
msg:='Fill nops: ';; wtime;
for i:=1 to n do blockwrite(f,tmp,1); writeln(' ok');
msg:='File wiped: ';  wtime;
close(f);
erase(f);
write(' ok');
halt;
end;
            {
procedure dod(way:st);
{Процедура удаления с
U.S DoD 5200.28-STD -}   {
var
tmp:buffer;ip:byte;
i:longword;
begin
write('Read file ');
init(n);
for ip:=1 to 7 do
begin
rewrite(f);
write(ip,'- pas ');
case ip of
1:fill(53,1,tmp);
2:fill(202,1,tmp);
3:fill(151,1,tmp);
4:fill(104,1,tmp);
5:fill(172,1,tmp);
6:fill(83,1,tmp);
7:fill(0,2,tmp);
end;
for i:=1 to n do blockwrite(f,tmp,1);
writeln('ok');
close(f);
erase(f);
end;
close(f);  
erase(f);
write('ok');
halt;  
end;  

procedure help;
begin
writeln('wipe.exe `way` mx');
writeln;
writeln('where way: c:\gostaina\passwords.txt or ');
writeln('passwords.txt wipe.exe in c:\gostaina\');
writeln('Where mx - metod of wipe');
writeln('m0 - fasters metod - just fill nops file');
writeln('m1 - medium metod - wipe file for 7 pas');
writeln('m2 - slowest and better metod wipe file for 35 pas');
writeln('m3 - fasters metod - 1 random pass ');
end;
         
procedure r(way:st);
var            
{Заливка файла псевдослучайной последовательностью}  
i:longword;
begin
writeln('Start 1 random pass');
writeln;
write('Read file ');
init(n);
rewrite(f); write('Fill random ');
for i:=1 to n do begin
                    fill(0,2,tmp);
                    blockwrite(f,tmp,1); writeln('ok');
                  end;
write('File wiped ');
close(f);  
erase(f);      
write('ok');
halt;
end;  
               
procedure gut(way:st);
{Алгоритм Питера гутманна}
var
ip,j:byte;
n,i:longword;
begin
write('Read file ');
AssignFile(F,way^);
reset(f);n:=0;
while (not eof(f)) do
begin {I"i^e`n~e^ e^i^e"-a^a` y'e"-o`i^a^}  
blockread(f,tmp,1);
inc(n);
end;writeln('ok');
for ip:=1 to 35 do begin
rewrite(f);j:=1;
write(ip,'- pas ');
case ip of
1..4:fill(0,2,tmp);
5:fill(85,1,tmp);
6:fill(170,1,tmp);
7:begin
case j of
1:fill(146,1,tmp);
2:fill(73,1,tmp);
3:fill(36,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
8:begin
case j of
1:fill(73,1,tmp);
2:fill(36,1,tmp);
3:fill(146,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
9:begin
case j of
1:fill(36,1,tmp);
2:fill(146,1,tmp);
3:fill(73,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
10:fill(0,1,tmp);
11:fill(17,1,tmp);
12:fill(34,1,tmp);
13:fill(51,1,tmp);
14:fill(68,1,tmp);
15:fill(85,1,tmp);
16:fill(102,1,tmp);
17:fill(119,1,tmp);
18:fill(136,1,tmp);
19:fill(153,1,tmp);
20:fill(170,1,tmp);
21:fill(187,1,tmp);
22:fill(204,1,tmp);
23:fill(221,1,tmp);
24:fill(238,1,tmp);
25:fill(255,1,tmp);
26:begin case j of
1:fill(146,1,tmp);
2:fill(73,1,tmp);
3:fill(36,1,tmp);
   end;if i=3 then i:=1 else inc(i);end;
27:begin
case j of
1:fill(73,1,tmp);
2:fill(36,1,tmp);
3:fill(146,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
28:begin
case j of
1:fill(36,1,tmp);
2:fill(146,1,tmp);
3:fill(73,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
29:begin
case j of
1:fill(109,1,tmp);
2:fill(182,1,tmp);
3:fill(219,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
30:begin
case j of
1:fill(182,1,tmp);
2:fill(219,1,tmp);
3:fill(109,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
31:begin
case j of
1:fill(219,1,tmp);
2:fill(109,1,tmp);
3:fill(182,1,tmp);
end;if i=3 then i:=1 else inc(i);end;
32..35:fill(0,2,tmp);
end;

for i:=1 to n do blockwrite(f,tmp,1);
writeln('ok');
close(f);
end;
writeln('File wiped ');
Erase(F);
writeln('ok');
end;    

function f_ex(way:st):boolean;
var f:file;
{фУНКЦИЯ налИчия файла}
begin
assign(f,way^);
filesetAttr(way^,128);
{$I-}reset(f);{$I+}
if IOresult=0 then begin f_ex:=true;close(f);end
else f_ex:=false;
end;

begin
new(way);new(wh);new(key);
way^:=ParamStr(1);
wh^:=ParamStr(2);
key^:=ParamStr(3);
if way^='help' then help;
if not f_ex(way) then begin writeln('File not exec! ');halt;end
else writeln('File exec = ok!');
if wh^[1]<>'m' then begin writeln('Invalid parameters');halt end;
val(copy(wh^,2,1),m,er);
case m of
0:nop(way); {
1:dod(way);
2:gut(way);
3:r(way); }
else begin writeln('Invalid parameters');halt end;
end;
dispose(way);dispose(wh);
readln
end.