{*******************************************************}
{ }
{ Unit for using Microsoft BITS }
{ }
{ Copyright (C) 2010 Heiko Adams }
{ }
{*******************************************************}
unit RifBackgroundCopyService;
interface
uses JwaWindows, ExtActns, Types, SysUtils;
type
TBackgroundCopyService =
class
private
FAttempts: Byte;
FJobId: TGUID;
CopyMngr: IBackgroundCopyManager;
CopyJob: IBackgroundCopyJob;
procedure DownloadUrl(
const aURL, aDest: WideString;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD);
procedure DownloadMultiUrl(
const aURL, aDest: TWideStringDynArray;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD);
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 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;
property JobId: TGUID
read FJobId;
end;
implementation
uses JclWin32, ComObj, JclSysInfo,
ActiveX;
constructor TBackgroundCopyService.Create();
begin
FAttempts := 3;
if not Succeeded(CoCreateInstance(CLSID_BackgroundCopyManager,
nil,
CLSCTX_LOCAL_SERVER, IID_IBackgroundCopyManager, CopyMngr))
then
RaiseLastOSError;
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;
DownloadUrl(aURL, aDest, aDisplayName, BG_JOB_TYPE_UPLOAD);
try
repeat
Result := ResumeJob(aDownloadFeedback);
Inc(nCount);
until Result
or (nCount >= FAttempts);
finally
CopyJob :=
nil;
end;
end;
function TBackgroundCopyService.DownloadFile(
const aURL, aDest: WideString;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
DownloadUrl(aURL, aDest, aDisplayName, BG_JOB_TYPE_DOWNLOAD);
try
repeat
Result := ResumeJob(aDownloadFeedback);
Inc(nCount);
until Result
or (nCount >= FAttempts);
finally
CopyJob :=
nil;
end;
end;
function TBackgroundCopyService.DownloadFiles(
const aURL, aDest: TWideStringDynArray;
const aDownloadFeedback: TDownloadProgressEvent;
const aDisplayName: WideString): Boolean;
var
nCount: Byte;
begin
nCount := 1;
DownloadMultiUrl(aURL, aDest, aDisplayName, BG_JOB_TYPE_DOWNLOAD);
try
repeat
Result := ResumeJob(aDownloadFeedback);
Inc(nCount);
until Result
or (nCount >= FAttempts);
finally
CopyJob :=
nil;
end;
end;
function TBackgroundCopyService.GetNewJob(
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE;
var aJob: IBackgroundCopyJob): Integer;
begin
Result := CopyMngr.CreateJob(PWideChar(aDisplayName), aJobType, FJobId, aJob);
end;
function TBackgroundCopyService.GetCopyJobError: HRESULT;
var
CopyError: IBackgroundCopyError;
Context: BG_ERROR_CONTEXT;
begin
CopyJob.GetError(CopyError);
try
CopyJob.Cancel;
CopyError.GetError(Context, Result);
finally
CopyError :=
nil;
end;
end;
function TBackgroundCopyService.ResumeJob(
const aDownloadFeedback: TDownloadProgressEvent): Boolean;
var
JobStatus: BG_JOB_STATE;
JobType: BG_JOB_TYPE;
begin
Result := False;
with CopyJob
do
begin
GetType(JobType);
Resume();
end;
JobStatus := WaitForDownload(JobType, aDownloadFeedback);
if (JobStatus
in [BG_JOB_STATE_TRANSFERRED,
BG_JOB_STATE_ERROR, BG_JOB_STATE_TRANSIENT_ERROR])
then
Result := (JobStatus = BG_JOB_STATE_TRANSFERRED);
if Result
then
CopyJob.Complete
else
RaiseLastOSError(GetCopyJobError);
end;
procedure TBackgroundCopyService.DownloadUrl(
const aURL, aDest: WideString;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD);
begin
if Assigned(CopyJob)
then
CopyJob :=
nil;
if not Succeeded(GetNewJob(aDisplayName, aJobType, CopyJob))
then
RaiseLastOSError;
if not Succeeded(CopyJob.AddFile(PWideChar(aURL), PWideChar(aDest)))
then
RaiseLastOSError;
end;
procedure TBackgroundCopyService.DownloadMultiUrl(
const aURL, aDest: TWideStringDynArray;
const aDisplayName: WideString;
const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD);
var
DownloadInfo: PBgFileInfo;
Info:
array of BG_FILE_INFO;
nCount: Integer;
begin
if Assigned(CopyJob)
then
CopyJob :=
nil;
if not Succeeded(GetNewJob(aDisplayName, aJobType, CopyJob))
then
RaiseLastOSError;
SetLength(Info, Length(aUrl));
ZeroMemory(@Info, SizeOf(Info));
try
for nCount := Low(aURL)
to High(aURL)
do
with Info[nCount]
do
begin
RemoteName := PWideChar(aUrl[nCount]);
LocalName := PWideChar(aDest[nCount]);
end;
DownloadInfo := @Info;
nCount := Length(Info);
if not Succeeded(CopyJob.AddFileSet(nCount, DownloadInfo))
then
RaiseLastOSError;
finally
SetLength(Info, 0);
end;
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;
sName: PWideChar;
Status: TURLDownloadStatus;
begin
CopyJob.GetDisplayName(sName);
bCanceled := False;
DueTime := -10000000;
hTimer := CreateWaitableTimerW(
nil, false, sName);
if (aJobType = BG_JOB_TYPE_DOWNLOAD)
then
Status := dsDownloadingData
else
Status := dsUploadingData;
try
SetWaitableTimer(hTimer, DueTime, 1000,
nil,
nil, false);
repeat
CopyJob.GetState(Result);
if (Result
in [BG_JOB_STATE_TRANSFERRING, BG_JOB_STATE_TRANSFERRED])
then
begin
CopyJob.GetProgress(JobProgress);
aDownloadFeedback(
nil, JobProgress.BytesTransferred, JobProgress.BytesTotal,
Status, '
', bCanceled);
if bCanceled
then
break;
end;
WaitForSingleObject(hTimer, INFINITE);
until (Result
in [BG_JOB_STATE_TRANSFERRED, BG_JOB_STATE_ERROR, BG_JOB_STATE_TRANSIENT_ERROR]);
finally
CancelWaitableTimer(hTimer);
CloseHandle(hTimer);
end;
end;
end.