function WipeFile(nam: string): byte; 
const 
  z = 512; 
var 
  p: array[0..z - 1] of byte; 
  tfs: TFileStream; 
  x: integer; 
begin 
  if fileexists(nam) then begin 
    try 
      fillmemory(@p, z, 63); 
      tfs := TFileStream.create(nam, fmopenwrite or fmShareExclusive); 
    except 
      result := 1; 
      exit; 
    end; 
    x := 0; 
    while x < tfs.size do begin 
      tfs.writebuffer(p, z); 
      inc(x, z); 
    end; 
    tfs.free; 
    result := 2; 
  end else result := 0; 
end; 
 
function SchredderFile(nam: string): byte; 
var 
  s: string; 
begin 
  result := wipefile(nam); 
  if result < 2 then exit; 
  s := extractfilepath(nam) + '~~~~~.tmp'; 
  if not renamefile(nam, s) then exit; 
  result := 3; 
  if not deletefile(s) then exit; 
  result := 4; 
end; 
 
 
procedure TForm1.Button5Click(Sender: TObject); 
var 
  s: string; 
begin 
  case SchredderFile('c:\test.bmp') of 
    0: s := 'Datei konnte nicht gefunden werden'; 
    1: s := 'Datei konnte nicht überschrieben werden'; 
    2: s := 'Datei konnte nicht umbenannt werden'; 
    3: s := 'Datei konnte nicht gelöscht werden'; 
  else s := 'fertig'; 
  end; 
  showmessage(s); 
end;