Shredder any File

Wer es vielleicht noch nicht wusste, Festplatten können nicht löschen, alles, was sie machen können, ist Schreiben. Deshalb ist eine Datei, nachdem sie angeblich gelöscht wurde, noch immer an demselben Platz, wo sie sich vorher befand, es wurde lediglich nur der Indikator des Verzeichnisbaums entfernt und die Speicheradresse frei gestellt. Deshalb kann diese Datei auch wieder hergestellt werden, und zwar im vollen Umfang, wenn nicht vorher die Speicheradresse von einem anderen Programm überschrieben wurde.

Um diese Datei endgültig von der Festplatte loszuwerden, muss man die Speicheradresse finden und einfach überschreiben. 

In der IT-Forensik nennt man das NULLEN.

..und so wird es gemacht.

procedure ShredderFile(FileName: string);
const
  Buffer       = 1024;
  Counttowrite = 34;
  FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);
var
  arr: array[1..Buffer] of Byte;
  f: file;
  i, j, n: Integer;
begin
  AssignFile(f, FileName);
  Reset(f, 1);
  n := FileSize(f);
  for j := 0 to CountToWrite do
  begin
    for i := 1 to n div Buffer do
    begin
      BlockWrite(f, FillBuffer[j], Buffer);
    end;
  end;
  CloseFile(f);
  RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');
  DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');
end;

procedure ShredderAndDeleteFile(const FileName: string);
var
  newname: string;
begin
  // zuerst umbennen, dann später keine Rückschlüsse auf den Dateinamen möglich sind
  newname := ExtractFilepath(FileName) + '$000000.tmp';
  if not RenameFile(FileName, newname) then
    raise
    Exception.CreateFmt('Fehlercode 2: Kann %s nicht umbenennen zugriff verweigert!', [FileName]);
  ShredderFile(newname);
  DeleteFile(newname);
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShredderAndDeleteFile('C:\temp.tmp')
end;