procedure ShredderFile(
const filename:
string);
const
Fillchars:
array[0..5]
of char = (Char($00), Char($FF), Char($00), Char($F0), Char($0F), Char($00));
BLOCK_SIZE = 8096;
var
fs : TStream;
buffer :
String;
i, j : Integer;
begin
fs := TFileStream.Create(filename, fmOpenReadWrite
or fmShareExclusive);
try
// Datei auf nächste Blockgrösse verlängern, damit der "Slack" überschrieben
// wird
fs.Size := ((fs.Size
div BLOCK_SIZE) +2) * BLOCK_SIZE;
// Datei soll mindestens 2 MB gross sein, damit die Schreibcaches der
// Festplatten überflutet werden
if fs.Size < 2097152
then
fs.Size := 2097152;
for i := 0
to 5
do
begin
fs.Position := 0;
buffer := StringofChar(Fillchars[i], BLOCK_SIZE);
for j := 1
to fs.Size
div BLOCK_SIZE
do
begin
fs.WriteBuffer(buffer[1], BLOCK_SIZE);
end;
FlushFileBuffers(fs.Handle);
end;
// zum Schluss belanglose Daten schreiben
buffer := '
2g642467894erp46FGHTZ&%%&/&)$%"&$%& 5675645 ';
fs.Position := 0;
for j := 1
to fs.Size
div Length(buffer)
do
begin
fs.WriteBuffer(buffer[1], Length(buffer));
end;
finally
fs.Free;
end;
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('
Can''
t rename file %s', [filename]);
ShredderFile(newname);
DeleteFile(newname);
end;