procedure TForm1.Button1Click(Sender: TObject);
var h:thandle;
var hs : thandlestream;
var b512 : Array512;
var b5120: Array5120;
var b:array of byte;
var i : integer;
var rimanenti:int64;
var b2: Buffer10240;
begin
try
try
button1.enabled := false;
bitbtn1.enabled := false;
h := fileopen(edit1.text, fmOpenWrite or fmShareExclusive);
hs := thandlestream.create(h);
for i := 0 to length(b512) - 1 do
begin
b512[i] := 0;
end;
for i := 0 to length(b5120) - 1 do
begin
b5120[i] := 0;
end;
for i := 0 to length(b2) - 1 do
begin
b2[i] := 0;
end;
sizedisk := hs.size;
rimanenti := hs.Size - 512;
perc := 0;
perc += 512;
hs.Write(b512[0], 512);
if (checkbox1.checked = false) then
begin
while (rimanenti >= 5120) do
begin
hs.write(b5120[0], 5120);
rimanenti := rimanenti - 5120;
perc += 5120;
application.ProcessMessages;
end;
if (rimanenti > 0) then
begin
setlength(b, rimanenti);
perc += rimanenti;
for i := 0 to length(b) - 1 do
begin
b[i] := 0;
end;
hs.write(b[0], sizeof(b));
application.ProcessMessages;
end;
end
else
begin
while (rimanenti >= 5120*2) do
begin
hs.write(b2[0], 5120*2);
rimanenti := rimanenti - 5120*2;
perc += 5120*2;
application.ProcessMessages;
end;
if (rimanenti > 0) then
begin
setlength(b, rimanenti);
perc += rimanenti;
for i := 0 to length(b) - 1 do
begin
b[i] := 0;
end;
hs.write(b[0], sizeof(b));
application.ProcessMessages;
end;
end;
except
on e: exception do
begin
end;
end;
finally
fileclose(h);
if (Assigned(hs)) then hs.Free;
button1.enabled := true;
bitbtn1.enabled := true;
end;
end;