unit BackgroundCopyService;
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;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
function DownloadMultiUrl(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
experimental;
function WaitForDownload(
const aJobType: BG_JOB_TYPE;
const aDownloadFeedback: TDownloadProgressEvent): BG_JOB_STATE;
function GetNewJob(
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE;
var aJob: IBackgroundCopyJob): Integer;
function GetCopyJobError: HRESULT;
function ResumeJob(
const aJobType: BG_JOB_TYPE;
const aDownloadFeedback: TDownloadProgressEvent): Boolean;
public
constructor Create;
destructor Destroy;
override;
function UploadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
function DownloadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
function DownloadFiles(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
experimental;
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;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
repeat
Result := DownloadUrl(aURL, aDest, aDownloadFeedback, aDisplayName,
BG_JOB_TYPE_UPLOAD);
Inc(nCount);
until Result
or (nCount > FAttempts);
end;
function TBackgroundCopyService.DownloadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
repeat
Result := DownloadUrl(aURL, aDest, aDownloadFeedback, aDisplayName,
BG_JOB_TYPE_DOWNLOAD);
Inc(nCount);
until Result
or (nCount > FAttempts);
end;
function TBackgroundCopyService.DownloadFiles(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
repeat
Result := DownloadMultiUrl(aURL, aDest, aDownloadFeedback,
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: HRESULT;
var
CopyError: IBackgroundCopyError;
Context: BG_ERROR_CONTEXT;
begin
CopyJob.GetError(CopyError);
CopyError.GetError(Context, Result);
CopyError :=
nil;
end;
function TBackgroundCopyService.ResumeJob(
const aJobType: BG_JOB_TYPE;
const aDownloadFeedback: TDownloadProgressEvent): Boolean;
var
JobStatus: BG_JOB_STATE;
begin
Result := False;
CopyJob.Resume();
JobStatus := WaitForDownload(aJobType, 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
RaiseLastOSError(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;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
begin
if Assigned(CopyJob)
then
CopyJob :=
nil;
if not Succeeded(GetNewJob(PWideChar(aDisplayName), aJobType, CopyJob))
then
RaiseLastOSError;
if not Succeeded(CopyJob.AddFile(PWideChar(aURL), PWideChar(aDest)))
then
RaiseLastOSError;
Result := ResumeJob(aJobType, aDownloadFeedback);
CopyJob :=
nil;
end;
function TBackgroundCopyService.DownloadMultiUrl(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;
var
DownloadInfo: PBgFileInfo;
Info: BG_FILE_INFO;
nCount: Integer;
begin
if Assigned(CopyJob)
then
CopyJob :=
nil;
if not Succeeded(GetNewJob(PWideChar(aDisplayName), aJobType, CopyJob))
then
RaiseLastOSError;
ZeroMemory(@Info, SizeOf(Info));
for nCount := Low(aURL)
to High(aURL)
do
begin
with Info
do
begin
RemoteName := PWideChar(aUrl[nCount]);
LocalName := PWideChar(aDest[nCount]);
end;
end;
DownloadInfo := @Info;
nCount := Length(aURL);
if not Succeeded(CopyJob.AddFileSet(nCount, DownloadInfo))
then
RaiseLastOSError;
Result := ResumeJob(aJobType, aDownloadFeedback);
CopyJob :=
nil;
end;
function TBackgroundCopyService.WaitForDownload(
const aJobType: BG_JOB_TYPE;
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.