[Olegator]

Знает кто, как удалить файл, переписав на его место несколько раз всякую фигню, чтоб никто не смог восстановить?

[Aristarh Dark]

Копай в сторону TFileStream.

ЗЫЖ Интересно, а для чего это нужно

[Ross]

Взято из delphiworld, статья называется "Удалить файл навсегда":

Код:

{ 
  If you want to get rid of a file normally you just delete it. 
  But someone else can undelete it if the file hasn't been wiped correctly. 
  For security purposes, to insure that certain files are permanently 
  gone, the WipeFile procedure writes over the data in the file with 
  random characters and then erases it. 

  Wenn man eine Datei nicht mehr braucht, loscht man sie einfach. 
  Aber jemand anders kann die Datei wieder herstellen, wenn sie 
  nicht "richtig" geloscht wurde. 
  Aus Sicherheitsgrunden, um sicherzustellen, dass eine Datei permanent 
  geloscht wird, uberschreibt die WipeFile Prozedur eine Datei mit 
  Zufalls-Zeichen und loscht sie anschliessend. 
}

 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;

[Olegator]

Сообщение от Aristarh Dark

Интересно, а для чего это нужно

Бывают разные причины: некоторые просто параноики, а мне для университета надо. А вообще полезная штука. FileRecovery все освоили, иногда надо поконкретнее удалить...

[Olegator]

Ross, пасиба! Буду пробовать и пытаться

[Ross]

пУзалУста. Рад помочь.

[Olegator]

В приведённом выше исходнике ошибка. Таже самая ошибка встречается ещё кое-где в инете. Вот так вот люди не совсем честно копируют исходники друг у друга... вместе с ошибками.

Вот как я доработал код. Ниже приведена процедура обработки нажатия кнопки "Open" формы "Form1" и кнопки "Delete" (в последней процедуре используется TrackBar "Num" с вариантами надёжности удаления - количества переписываний файла). Вариант рабочего кода в совершенно никаком оформлени можно скачать в прикреплённом файле.

Код:

procedure TForm1.OpenClick(Sender: TObject);
var
 FileName: string;

begin
OpenDialog1.Execute;

FileName:=OpenDialog1.FileName;

Path.Caption:= FileName;
end;

procedure TForm1.DeleteClick(Sender: TObject);
 var
   buffer: array [0..4095] of Byte;
   max, n: LongInt;
   i,j,k: Integer;
   fs: TFileStream;
   FileName: String;
 begin

 case Num.Position of
0: k:=1;
1: k:=3;
2: k:=5;
3: k:=10;
4: k:=15;

end;
   FileName:= Path.Caption;
   fs := TFilestream.Create(FileName, fmOpenReadWrite or fmShareExclusive);
   try
     for i := 1 to k do
     begin
            for j := Low(buffer) to High(buffer) do
       buffer[j] := Random(256);
       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);
   ShowMessage('Все пучком');
 end;