dateien sicher löschen

[phreax]

In den Jedis gibt es diese Funktion ich habe diese mal extrahiert, hier da Unit aber Beachte das immer noch die Jedi Lizenz gilt

Delphi-Quellcode:

unit MyFileUtils;

interface

procedure ShredFile(const FileName: string; Times: Integer);

implementation

uses Classes,Windows,sysUtils,forms;

function FileGetSize(const FileName: string): Integer;
var
  SearchRec: TSearchRec;
{$IFDEF MSWINDOWS}
  OldMode: Cardinal;
{$ENDIF MSWINDOWS}
begin
  Result := -1;
{$IFDEF MSWINDOWS}
  OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  try
{$ENDIF MSWINDOWS}
    if FindFirst(FileName, faAnyFile, SearchRec) = 0 then
    begin
      Result := SearchRec.Size;
      SysUtils.FindClose(SearchRec);
    end;
{$IFDEF MSWINDOWS}
  finally
    SetErrorMode(OldMode);
  end;
{$ENDIF MSWINDOWS}
end;

procedure ShredFile(const FileName: string; Times: Integer);
const
  BUFSIZE   = 4096;
  ODD_FILL  = $C1;
  EVEN_FILL = $3E;
var
  Fs: TFileStream;
  Size: Integer;
  N: Integer;
  ContentPtr: Pointer;
begin
  Size := FileGetSize(FileName);
  if Size > 0 then
  begin
    if Times < 0 then
      Times := 2
    else
      Times := Times * 2;
    ContentPtr := nil;
    Fs := TFileStream.Create(FileName, fmOpenReadWrite);
    try
      GetMem(ContentPtr, BUFSIZE);
      while Times > 0 do
      begin
        if Times mod 2 = 0 then
          FillMemory(ContentPtr, BUFSIZE, EVEN_FILL)
        else
          FillMemory(ContentPtr, BUFSIZE, ODD_FILL);
        Fs.Seek(0, soFromBeginning);
        Application.ProcessMessages;
        N := Size div BUFSIZE;
        while N > 0 do
        begin
          if n mod 50 = 0 then Application.ProcessMessages;
          Fs.Write(ContentPtr^, BUFSIZE);
          Dec(N);
        end;
        N := Size mod BUFSIZE;
        if N > 0 then
          Fs.Write(ContentPtr^, N);
        FlushFileBuffers(Fs.Handle);
        Dec(Times);
      end;
    finally
      if ContentPtr <> nil then
        FreeMem(ContentPtr, Size);
      Fs.Free;
      DeleteFile(FileName);
    end;
  end
  else
    DeleteFile(FileName);
end;

end.

mfg phreax