procedure ShredFil(
const FileName:
string; Times: Integer);
const
BUFSIZE = 4096;
ODD_FILL = $C1;
EVEN_FILL = $3E;
var
Fs: TFileStream;
Size: Integer;
N: Integer;
OldTimes: Integer;
ContentPtr: Pointer;
begin
Size := FileGetSize(FileName);
if Size > 0
then
begin
if Times < 0
then
Times := 2
else
Times := Times * 2;
OldTimes:= Times;
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);
N := Size
div BUFSIZE;
while N > 0
do
begin
Fs.
Write(ContentPtr^, BUFSIZE);
Dec(N);
end;
N := Size
mod BUFSIZE;
if N > 0
then
Fs.
Write(ContentPtr^, N);
FlushFileBuffers(Fs.Handle);
Dec(Times);
Form1.display(ceil((oldtimes - times + 1)/2), trunc(oldtimes/2));
//Anzeigen
Application.ProcessMessages;
end;
finally
if ContentPtr <>
nil then
FreeMem(ContentPtr, Size);
Fs.Free;
end;
end;
DeleteFile(FileName);
end;
{...}
procedure TForm1.display(laeufe, gesamt: integer);
begin
label4.Caption:= IntToStr(laeufe) + '
Durchgänge abgehakt';
Gauge1.Progress:= round(laeufe*100/gesamt);
end;