procedure ShowError(ErrorMessage:
String);
var
E: HRESULT;
begin
E := GetLastError;
raise Exception.Create(ErrorMessage + '
:' + sLineBreak + SysErrorMessage(E));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, O: THandle;
P, L: Int64;
S, X, C, W, V: LongWord;
T: TOverlapped;
B:
array of Byte;
Q: LongInt;
begin
if not GetDiskFreeSpace(PChar(ExtractFileDir(ButtonedEdit1.Text)), X, S, X, X)
then S := 4096;
i := INVALID_HANDLE_VALUE;
O := INVALID_HANDLE_VALUE;
try
i := CreateFile(PChar(ButtonedEdit1.Text), GENERIC_READ, FILE_SHARE_READ,
nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL
or FILE_FLAG_NO_BUFFERING
or FILE_FLAG_OVERLAPPED
or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if i = INVALID_HANDLE_VALUE
then ShowError('
Kann Quelldatei nicht öffnen');
O := CreateFile(PChar(ButtonedEdit2.Text), GENERIC_WRITE, FILE_SHARE_READ,
nil, CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL
or FILE_FLAG_NO_BUFFERING
or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if O = INVALID_HANDLE_VALUE
then ShowError('
Kann Zieldatei nicht öffnen');
Int64Rec(L).Lo := GetFileSize(i, @Int64Rec(L).Hi);
if L = INVALID_FILE_SIZE
then ShowError('
Dateigröße nicht lesbar');
SetLength(B, S);
V := GetTickCount;
P := 0;
while (P < L)
and not Application.Terminated
do
try
if GetTickCount - V > 150
then begin
Label2.Caption := Format('
%.0n / %.0n', [P / 1, L / 1]);
ProgressBar1.Position := (P * 1000)
div L;
Application.ProcessMessages;
V := GetTickCount;
end;
if CheckBox1.Checked
then begin
T.InternalHigh := 0;
// reset OverlappedResult
T.InternalHigh := 0;
//
T.Offset := Int64Rec(P).Lo;
T.OffsetHigh := Int64Rec(P).Hi;
Q := 0;
TSimpleThread.Create(
procedure
begin
try
ReadFile(i, B[0], S, X, @T);
if not GetOverlappedResult(i, T, C, True)
or (C <> S)
Then ShowError('
Lesefehler');
InterlockedExchange(Q, 1);
except
InterlockedExchange(Q, 2);
raise;
end;
end);
W := GetTickCount;
while (Q < 1)
and (GetTickCount - W < 15000)
do begin
Application.ProcessMessages;
Sleep(10);
end;
if Q = 0
then begin
TSimpleThread.Create(
procedure
begin
try
CancelIoEx(i, T);
InterlockedExchange(Q, 3);
except
InterlockedExchange(Q, 4);
raise;
end;
end);
W := GetTickCount;
while (Q < 3)
and (GetTickCount - W < 500)
do begin
Application.ProcessMessages;
Sleep(10);
end;
end else if Q <> 1
then Exit;
end else begin
T.InternalHigh := 0;
// reset OverlappedResult
T.InternalHigh := 0;
//
T.Offset := Int64Rec(P).Lo;
T.OffsetHigh := Int64Rec(P).Hi;
ReadFile(i, B[0], S, X, @T);
if not GetOverlappedResult(i, T, C, True)
or (C <> S)
Then ShowError('
Lesefehler');
end;
X := Int64Rec(P).Hi;
if (SetFilePointer(O, Int64Rec(P).Lo, @X, FILE_BEGIN) <> Int64Rec(P).Lo)
or (X <> Int64Rec(P).Hi)
then
ShowError('
Positionsfehler');
X := Min(L - P, S);
if not WriteFile(O, B[0], X, C,
nil)
or (C <> X)
then ShowError('
Schreibfehler');
Inc(P, S);
except
Inc(P, S);
end;
finally
CloseHandle(O);
CloseHandle(i);
CloseHandle(T.hEvent);
end;
end;