Hier mal eine selbstgeschriebene Klasse, zur Nutzung des Background Intelligent Transfer Service (BITS) von Windows:

zusammenfalten · markieren

Delphi-Quellcode:

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.

Wie unschwer zu erkennen ist, werden die Jedi API-Header benötigt.

Warum nutzt du PWideChar überhaupt?

aError := PWideChar(WideString(SysErrorMessage(Res)));

reine Bequemlichkeit. Habs aber trotzdem mal auf WideString als Datentyp für aError geändert

Zitat:

markieren

Delphi-Quellcode:

function TBackgroundCopyService.DownloadMultiUrl(const aURL, aDest: TWideStringDynArray;
  const aDownloadFeedback: TDownloadProgressEvent; var aError: PWideChar;
  const aDisplayName: PWideChar;
  const aJobType: BG_JOB_TYPE = BG_JOB_TYPE_DOWNLOAD): Boolean;

begin
  
  aError := PWideChar(WideString(SysErrorMessage(Res)));

Du weißt aber, daß das Ergebnis der WideString-Konvertierung in einer temporären und vorallem lokalen variable abgelegt wird, bevor davon via PWideChar ein Zeiger darauf besorgt wird.
Diese Variable wird beim verlassen der Prozedur freigegeben und somit zeigt der PWideChar ins "Nichts".

Habs schon geändert. Alle Parameter sind in WideString geändert.

Wäre eh besser
raiseLastOSError zu verwenden, als einen FehlerSTRING zurückzugeben, den man nicht nutzen kann, um auf einen Fehler im Programmcode zu reagieren.

Hast du dich etwa vom aktuellen Entwickler Magazin inspirieren
lassen?
Dort ist im Uptodate Artikel auch was zum BITs drin.
Dein Source sieht an manchen stellen sehr sehr ähnlich aus.

Sagen wir mal, ich habe den Source aus dem Entwicklermagazin als Grundlage genutzt und (hoffentlich) sinnvoll ergänzt und erweitert

Zitat von Dezipaitor:

Wäre eh besser raiseLastOSError zu verwenden, als einen FehlerSTRING zurückzugeben, den man nicht nutzen kann, um auf einen Fehler im Programmcode zu reagieren.

Du immer mit Deinen Exceptions Ich halte nicht viel davon, bei jedem Fehler eine Exception zu werfen. Einen aussagekräftigen Returncode bzw. eine eindeutige Fehlermeldung halte ich für viel hilfreicher. Immerhin kann man so die aufgerufene Prozedur/Funktion kontrolliert beenden.

Zitat von HeikoAdams:

Immerhin kann man so die aufgerufene Prozedur/Funktion kontrolliert beenden.

Try-Except/Finally?

Und man kann auch einen nummerischen Fehlercode in der Exception hinterlegen.