Function FileShredder_Gutmann(FileName: WideString): Boolean;
// Dateishredder Funktion > Algorithmus Gutmann
// [url]http://en.wikipedia.org/wiki/Gutmann_method[/url]
//
// © 1997-2007 by FNS Enterprize's
// © 2003-2007 by himitsu @ Delphi-PRAXiS
Type TTrippleByte =
packed Array[1..3]
of Byte;
PTrippleByte = ^TTrippleByte;
Const Mask:
Array[5..31]
of TTrippleByte = (
($55, $55, $55), ($AA, $AA, $AA), ($92, $49, $24), ($49, $24, $92),
($24, $92, $49), ($00, $00, $00), ($11, $11, $11), ($22, $22, $22),
($33, $33, $33), ($44, $44, $44), ($55, $55, $55), ($66, $66, $66),
($77, $77, $77), ($88, $88, $88), ($99, $99, $99), ($AA, $AA, $AA),
($BB, $BB, $BB), ($
CC, $
CC, $
CC), ($DD, $DD, $DD), ($EE, $EE, $EE),
($FF, $FF, $FF), ($92, $49, $24), ($49, $24, $92), ($24, $92, $49),
($6D, $B6, $
DB), ($B6, $
DB, $6D), ($
DB, $6D, $B6));
Var S: WideString;
H: THandle;
Len: LARGE_INTEGER;
C: PWideChar;
SectorSize, Pass, i: Integer;
W: Cardinal;
Pos, Sectors: Int64;
Buffer:
Array of Byte;
Begin
Result := False;
// Verzeichnis erweitern
S := FileName;
SetLength(FileName, MAX_PATH);
SetLength(FileName, GetFullPathNameW(PWideChar(S), MAX_PATH, @FileName[1], C));
// Datei öffnen (unter Umgehung der FileCache) und Größe auslesen
H := CreateFileW(PWideChar(S), GENERIC_WRITE, FILE_SHARE_READ,
nil,
OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN
or FILE_FLAG_WRITE_THROUGH, 0);
//If H = INVALID_HANDLE_VALUE Then Exit;
Len.LowPart := GetFileSize(H, @Len.HighPart);
If (Len.LowPart = INVALID_FILE_SIZE)
and (GetLastError <> NO_ERROR)
Then Exit;
Try
// Sectrogröße für direktzuriff ermitteln
S := FileName;
While not GetDiskFreeSpaceW(PWideChar(S), W, Cardinal(SectorSize), W, W)
do Begin
i := Length(S);
While (i > 0)
and not (S[i]
in [WideChar('
:'), WideChar('
\')])
do Dec(i);
If (i > 1)
and (S[i] = '
\')
and (S[i - 1] <> '
:')
Then Dec(i);
If i = Length(S)
Then Begin
SectorSize := 512;
Break;
End;
Delete(S, i + 1, MAX_PATH);
End;
Sectors := (Len.QuadPart + SectorSize - 1)
div SectorSize;
i := SectorSize;
While i
mod SizeOf(TTrippleByte) <> 0
do Inc(i, SectorSize);
SetLength(Buffer, i);
For Pass := 1
to 35
do Begin
// Schreibpuffer füllen
For i := 0
to Length(Buffer)
div SizeOf(TTrippleByte) - 1
do
If (Pass < Low(Mask))
or (Pass > High(Mask))
Then Begin
Buffer[i * SizeOf(TTrippleByte)] := Random(256);
Buffer[i * SizeOf(TTrippleByte) + 1] := Random(256);
Buffer[i * SizeOf(TTrippleByte) + 1] := Random(256);
End Else PTrippleByte(@Buffer[i * SizeOf(TTrippleByte)])^ := Mask[Pass];
// Datei überschreiben
SetFilePointer(H, 0,
nil, FILE_BEGIN);
Pos := 0;
While Pos < Sectors
do Begin
i := Min(Sectors - Pos, Length(Buffer)
div Integer(SectorSize));
If not WriteFile(H, Buffer[0], i * SectorSize, W,
nil)
or (Integer(W) <> i * SectorSize)
Then Exit;
Inc(Pos, i);
End;
End;
Finally
CloseHandle(H);
End;
// Datei löschen
Result := DeleteFileW(PWideChar(FileName));
End;