Shred Files - Delete Files Securely

procedure ShredFile(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 ShredAndDeleteFile(const FileName: string);

var

  newname: string;

begin

  newname := ExtractFilepath(FileName) + '$000000.tmp';

  if not RenameFile(FileName, newname) then

    raise

    Exception.CreateFmt('Fehlercode 2: Can %s not Delete!', [FileName]);

  ShredFile(newname);

  DeleteFile(newname);

end;