unit RifBackgroundCopyService;
interface
uses ExtActns, JwaWindows, Types, SysUtils;
type
EInitServiceError =
Exception;
TBackgroundCopyService =
class
private
FAttempts: Byte;
CopyMngr: IBackgroundCopyManager;
CopyJob: IBackgroundCopyJob;
function DownloadUrl(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
function DownloadMultiUrl(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
function WaitForDownload(
const aJobType: BG_JOB_TYPE;
var aError: WideString;
const aDownloadFeedback: TDownloadProgressEvent): BG_JOB_STATE;
function GetNewJob(
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE;
var aJob: IBackgroundCopyJob): Integer;
function GetCopyJobError: WideString;
function ResumeJob(
const aJobType: BG_JOB_TYPE;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString): Boolean;
public
constructor Create;
destructor Destroy;
override;
function UploadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString): Boolean;
function DownloadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString): Boolean;
function DownloadFiles(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString): Boolean;
property AttemptsOnFailure: Byte
read FAttempts
write FAttempts;
end;
implementation
uses JclWin32, ComObj, JclSysInfo;
constructor TBackgroundCopyService.Create();
begin
FAttempts := 3;
CopyMngr := CreateComObject(CLSID_BackgroundCopyManager)
as IBackgroundCopyManager;
if not Assigned(CopyMngr)
then
raise EInitServiceError.Create('
Initialization of BackgroundCopyService failed!');
end;
destructor TBackgroundCopyService.Destroy;
begin
inherited;
if Assigned(CopyJob)
then
CopyJob :=
nil;
if Assigned(CopyMngr)
then
CopyMngr :=
nil;
end;
function TBackgroundCopyService.UploadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
repeat
Result := DownloadUrl(aURL, aDest, aDownloadFeedback, aError, aDisplayName,
BG_JOB_TYPE_UPLOAD);
Inc(nCount);
until Result
or (nCount > FAttempts);
end;
function TBackgroundCopyService.DownloadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
repeat
Result := DownloadUrl(aURL, aDest, aDownloadFeedback, aError, aDisplayName,
BG_JOB_TYPE_DOWNLOAD);
Inc(nCount);
until Result
or (nCount > FAttempts);
end;
function TBackgroundCopyService.DownloadFiles(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
repeat
Result := DownloadMultiUrl(aURL, aDest, aDownloadFeedback, aError,
aDisplayName, BG_JOB_TYPE_DOWNLOAD);
Inc(nCount);
until Result
or (nCount > FAttempts);
end;
function TBackgroundCopyService.GetNewJob(
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE;
var aJob: IBackgroundCopyJob): Integer;
var
JobId: TGUID;
begin
Result := CopyMngr.CreateJob(PWideChar(aDisplayName), aJobType, JobId, aJob);
end;
function TBackgroundCopyService.GetCopyJobError: WideString;
var
CopyError: IBackgroundCopyError;
sTemp: PWideChar;
begin
CopyJob.GetError(CopyError);
CopyError.GetErrorDescription(LANGIDFROMLCID(GetThreadLocale()), sTemp);
CopyError :=
nil;
Result := WideString(WideCharToString(sTemp));
end;
function TBackgroundCopyService.ResumeJob(
const aJobType: BG_JOB_TYPE;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString): Boolean;
var
JobStatus: BG_JOB_STATE;
begin
Result := False;
CopyJob.Resume();
JobStatus := WaitForDownload(aJobType, aError, aDownloadFeedback);
if (JobStatus
in [BG_JOB_STATE_TRANSFERRED,
BG_JOB_STATE_ERROR, BG_JOB_STATE_TRANSIENT_ERROR])
then
begin
Result := (JobStatus = BG_JOB_STATE_TRANSFERRED);
if not Result
then
aError := GetCopyJobError;
end;
if (JobStatus = BG_JOB_STATE_TRANSFERRED)
then
CopyJob.Complete
else
CopyJob.Cancel;
end;
function TBackgroundCopyService.DownloadUrl(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
var
Res: HRESULT;
begin
if Assigned(CopyJob)
then
CopyJob :=
nil;
Result := False;
Res := GetNewJob(PWideChar(aDisplayName), aJobType, CopyJob);
if not Succeeded(Res)
then
begin
aError := WideString(SysErrorMessage(Res));
Exit;
end;
Res := CopyJob.AddFile(PWideChar(aURL), PWideChar(aDest));
if not Succeeded(Res)
then
begin
aError := WideString(SysErrorMessage(Res));
Exit;
end;
Result := ResumeJob(aJobType, aDownloadFeedback, aError);
CopyJob :=
nil;
end;
function TBackgroundCopyService.DownloadMultiUrl(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
var aError: WideString;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
var
DownloadInfo: PBgFileInfo;
Res: HRESULT;
nCount: Integer;
begin
if Assigned(CopyJob)
then
CopyJob :=
nil;
Result := False;
Res := GetNewJob(PWideChar(aDisplayName), aJobType, CopyJob);
if not Succeeded(Res)
then
begin
aError := WideString(SysErrorMessage(Res));
Exit;
end;
ZeroMemory(@DownloadInfo, SizeOf(DownloadInfo));
for nCount := Low(aURL)
to High(aURL)
do
begin
DownloadInfo.RemoteName := PWideChar(aUrl[nCount]);
DownloadInfo.LocalName := PWideChar(aDest[nCount]);
end;
nCount := Length(aURL);
Res := CopyJob.AddFileSet(nCount, DownloadInfo);
if not Succeeded(Res)
then
begin
aError := WideString(SysErrorMessage(Res));
Exit;
end;
Result := ResumeJob(aJobType, aDownloadFeedback, aError);
CopyJob :=
nil;
end;
function TBackgroundCopyService.WaitForDownload(
const aJobType: BG_JOB_TYPE;
var aError: WideString;
const aDownloadFeedback: TDownloadProgressEvent): BG_JOB_STATE;
var
JobProgress: BG_JOB_PROGRESS;
hTimer: THandle;
DueTime: TLargeInteger;
bCanceled: boolean;
begin
bCanceled := False;
DueTime := -10000000;
hTimer := CreateWaitableTimer(
nil, false, '
EinTimer');
SetWaitableTimer(hTimer, DueTime, 1000,
nil,
nil, false);
while True
do
begin
CopyJob.GetState(Result);
if (Result
in [BG_JOB_STATE_TRANSFERRING, BG_JOB_STATE_TRANSFERRED])
then
begin
CopyJob.GetProgress(JobProgress);
if (aJobType = BG_JOB_TYPE_DOWNLOAD)
then
aDownloadFeedback(
nil, JobProgress.BytesTransferred, JobProgress.BytesTotal,
dsDownloadingData, '
', bCanceled)
else
aDownloadFeedback(
nil, JobProgress.BytesTransferred, JobProgress.BytesTotal,
dsUploadingData, '
', bCanceled);
if bCanceled
then
break;
end;
if (Result
in [BG_JOB_STATE_TRANSFERRED,
BG_JOB_STATE_ERROR, BG_JOB_STATE_TRANSIENT_ERROR])
then
break;
WaitForSingleObject(hTimer, INFINITE);
end;
CancelWaitableTimer(hTimer);
CloseHandle(hTimer);
end;
end.