Brug af Winapi MoveFileWithProgress
Jeg prøver, i XE3, med et 32bit program, at bruge MoveFileWithProgress til at flytte nogle filer og tager udgangspunkt i dette: http://delphidabbler.com/tips/160.Funktionen:
http://msdn.microsoft.com/en-us/library/windows/desktop/aa365242(v=vs.85).aspx
Call back headeren:
http://msdn.microsoft.com/en-us/library/windows/desktop/aa363854(v=vs.85).aspx
Ideen er at kalde MS' procedure for at flytte filer. Ved at koble en call back procedure på, kan jeg lave min egen visning af fremskridt.
Headeren er den samme om det er copy eller move så der afviger den ikke fra Peter Belows udgangspunkt. Har også prøvet med CopyFileEx og der er adresserne også forkerte:
function MoveCallback(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: Int64;
dwStreamNumber, dwCallbackReason: DWORD;
hSourceFile, hDestinationFile: THandle;
Data: LPVOID): DWORD; stdcall;
dwStreamNumber, dwCallbackReason: DWORD;
hSourceFile, hDestinationFile: THandle;
Data: LPVOID): DWORD; stdcall;
Problemet er parameteren Data som er en pointer til de data man gerne vil have ført med over i sin call back, eksempelvis en label der skal opdateres, eller en progressbar. Det virker bare ikke!
Hvis jeg tager adressen på panelet, hvis caption jeg vil bruge, så er den en ting før kaldet og en anden inde i call back'en. Kan nogen hjælpe mig?
Call back funktionen er her:
function MoveCallback(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: Int64;
dwStreamNumber, dwCallbackReason: DWORD;
hSourceFile, hDestinationFile: THandle;
aData: LPVOID): DWORD; stdcall;
var
Pct: Integer;
const
PROCESS_CONTINUE = 0; // carry on
PROCESS_CANCEL = 1; // cancel and delete dest-file
PROCESS_STOP = 2; // pause
PROCESS_QUIET = 3; // don't call the call back routine no more
begin
Result := PROCESS_CONTINUE;
if dwCallbackReason = CALLBACK_CHUNK_FINISHED then
begin
if TotalBytesTransferred mod 100 = 0 then
begin
Pct := muldiv(100,TotalBytesTransferred,TotalFileSize);
OutputDebugString(pchar('aData: ' + IntToHex(integer(addr(aData)),8)));
//OutputDebugString(pchar(format('Flytter %s (%d/%d bytes) - %d %%',['',TotalBytesTransferred,TotalFileSize,NewPos])));
// xx.Caption := ;
Application.ProcessMessages;
end;
end;
end;
dwStreamNumber, dwCallbackReason: DWORD;
hSourceFile, hDestinationFile: THandle;
aData: LPVOID): DWORD; stdcall;
var
Pct: Integer;
const
PROCESS_CONTINUE = 0; // carry on
PROCESS_CANCEL = 1; // cancel and delete dest-file
PROCESS_STOP = 2; // pause
PROCESS_QUIET = 3; // don't call the call back routine no more
begin
Result := PROCESS_CONTINUE;
if dwCallbackReason = CALLBACK_CHUNK_FINISHED then
begin
if TotalBytesTransferred mod 100 = 0 then
begin
Pct := muldiv(100,TotalBytesTransferred,TotalFileSize);
OutputDebugString(pchar('aData: ' + IntToHex(integer(addr(aData)),8)));
//OutputDebugString(pchar(format('Flytter %s (%d/%d bytes) - %d %%',['',TotalBytesTransferred,TotalFileSize,NewPos])));
// xx.Caption := ;
Application.ProcessMessages;
end;
end;
end;
Kaldet her:
OutputDebugString(pchar('pProgress: ' + IntToHex(integer(addr(pProgress)),8)));
if not MoveFileWithProgress(pchar(Src + Filename),
pchar(Dst + Filename),
addr(MoveCallback),
pointer(pProgress),
MOVEFILE_COPY_ALLOWED or MOVEFILE_WRITE_THROUGH) then
begin
LastError := GetLastError;
MessageDlg(format('GetLastError: %d (%s)',[LastError,SysErrorMessage(LastError)]), mtInformation, [mbOK], 0);
end;
if not MoveFileWithProgress(pchar(Src + Filename),
pchar(Dst + Filename),
addr(MoveCallback),
pointer(pProgress),
MOVEFILE_COPY_ALLOWED or MOVEFILE_WRITE_THROUGH) then
begin
LastError := GetLastError;
MessageDlg(format('GetLastError: %d (%s)',[LastError,SysErrorMessage(LastError)]), mtInformation, [mbOK], 0);
end;
