Background Intelligent Transfer Service nutzen

[HeikoAdams]

Okay, dann halt mit Exceptions:

Delphi-Quellcode:

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.