Прогу, удаляющую каталоги со всем содержимым надо объединить с прогой, удаляющей файлы по принципу WipeInfo. Т.е. сделать прогу,
удаляющую каталог со всем содержимым по принципу нортоновского wipeinfo.

------1-я прога { Удалить каталог со всем содержимым }--------

function DeleteDir(Dir  : string)  : boolean;
Var
Found  : integer;
SearchRec : TSearchRec;
begin  result:=false;
if IOResult<>0 then ;
ChDir(Dir);  
if IOResult<>0 then
begin  
ShowMessage('Не могу войти в каталог: '+Dir);
exit;  
end;
Found := FindFirst('*.*', faAnyFile, SearchRec);
while Found = 0 do  
begin  
if (SearchRec.Name<>'.')and(SearchRec.Name<>'..') then  
if (SearchRec.Attr and faDirectory)<>0 then
begin    
if not DeleteDir(SearchRec.Name) then exit;  
end
else  
if not DeleteFile(SearchRec.Name) then
begin    
ShowMessage('Не могу удалить файл: '+SearchRec.Name);
exit;    
end;
Found := FindNext(SearchRec);
end;  
FindClose(SearchRec);
ChDir('..');
RmDir(Dir);
result:=IOResult=0;
end;


---------2-ая прога WipeInfo -------------------------

procedure WipeFile(FileName: string);
var
buffer: array [0..4095] of Byte;
max, n: LongInt;
i: Integer;
fs: TFileStream;

procedure RandomizeBuffer;
var
i: Integer;
begin
for i := Low(buffer) to High(buffer) do
buffer[i] := Random(256);
end;
begin
fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
try
for i := 1 to 3 do
begin
RandomizeBuffer;
max     := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max=SizeOf(buffer) then
 n := SizeOf(buffer)
else
 n := max;
fs.Write(Buffer, n);
max := max - n;
end;
FlushFileBuffers(fs.Handle);
end;
finally
fs.Free;
end;
Deletefile(FileName);
end;

-----------------------------------------------

Большое спасибо всем кто откликнется.

Цитата

if not DeleteFile(SearchRec.Name) then

Заменяешь на

Код

if not _DeleteFile(SearchRec.Name) then ... вот описание этой функции: Function _DeleteFile(FileName:string):boolean; begin  result:=true;  try    WipeFile(FileName);    result:=DeleteFile(FileName);  except    result:=false;  end; end;