Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Delphi Background Intelligent Transfer Service nutzen (https://www.delphipraxis.net/153529-background-intelligent-transfer-service-nutzen.html)

HeikoAdams 6. Aug 2010 13:37
Background Intelligent Transfer Service nutzen
 
Hier mal eine selbstgeschriebene Klasse, zur Nutzung des Background Intelligent Transfer Service (BITS) von Windows:

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.

Dezipaitor 6. Aug 2010 14:54
AW: Background Intelligent Transfer Service nutzen
 
Warum nutzt du PWideChar überhaupt?

Delphi-Quellcode:
aError := PWideChar(WideString(SysErrorMessage(Res)));

HeikoAdams 6. Aug 2010 15:04
AW: Background Intelligent Transfer Service nutzen
 
reine Bequemlichkeit. Habs aber trotzdem mal auf WideString als Datentyp für aError geändert

himitsu 6. Aug 2010 15:14
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
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". :warn:

HeikoAdams 6. Aug 2010 15:20
AW: Background Intelligent Transfer Service nutzen
 
Habs schon geändert. Alle Parameter sind in WideString geändert.

Dezipaitor 6. Aug 2010 15:48
AW: Background Intelligent Transfer Service nutzen
 
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.

generic 6. Aug 2010 15:55
AW: Background Intelligent Transfer Service nutzen
 
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.

;-)

HeikoAdams 6. Aug 2010 16:00
AW: Background Intelligent Transfer Service nutzen
 
Sagen wir mal, ich habe den Source aus dem Entwicklermagazin als Grundlage genutzt und (hoffentlich) sinnvoll ergänzt und erweitert ;)

HeikoAdams 6. Aug 2010 16:04
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
Zitat von Dezipaitor (Beitrag 1040051)
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 :-D 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.

himitsu 6. Aug 2010 16:26
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
Zitat von HeikoAdams (Beitrag 1040057)
Immerhin kann man so die aufgerufene Prozedur/Funktion kontrolliert beenden.
Try-Except/Finally?

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

NormanNG 6. Aug 2010 17:16
AW: Background Intelligent Transfer Service nutzen
 
Hi,

kann es sein, das in der Funktion TBackgroundCopyService.DownloadMultiUrl noch ein Fehler ist?
Ist die Scheife zum Befüllen von DownloadInfo nicht falsch?

Delphi-Quellcode:
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;
:
  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);
:

Luckie 6. Aug 2010 17:32
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
Zitat von HeikoAdams (Beitrag 1040057)
Du immer mit Deinen Exceptions :-D Ich halte nicht viel davon, bei jedem Fehler eine Exception zu werfen.
Dann hast du den Sinn von Exceptions nicht verstanden. Was ist übersichtlicher:
Delphi-Quellcode:
try
  AufrufFunktion;
  AufrufFunktion;
  AufrufFunktion;
  AufrufFunktion;
  AufrufFunktion;
  AufrufFunktion;
except
  // Fehlerbehandlung
  on E: Exception do
    ShowMessage(E.Message); // Aussagekräftige Fehlermeldung aus Funktion, die Exception wirft
end;
oder

Delphi-Quellcode:
  if Anweisung then
    if Anweisung then
      if Anweisung then
        if Anweisung then
          if Anweisung then

          else
            // Fehlerbehandlung
         else
          // Fehlerbehandlung
      else
        // Fehlerbehandlung
    else
      // Fehlerbehandlung
  else
    // Fehlerbehandlung
Mittels Exceptions kann man fehler zentral an einer Stelle behandlen. Der Code wird damit einfachher lesbar, übersichtlicher und wartbarer.

Und noch was, wenn du schon objektorientiert programmierst, warum dann nicht auch bei der Fehlerbhandlung?

HeikoAdams 8. Aug 2010 12:08
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
Zitat von Luckie (Beitrag 1040072)
Dann hast du den Sinn von Exceptions nicht verstanden.
Doch, ich habe den Sinn schon verstanden. Nur in diesem Fall halte ich Exceptions für überflüssig, weil ich ausschließlich API-Routinen nutze, die mir im Fehlerfall einen Fehlercode zurückliefern. Wenn ich eigene Funktionen schreibe, nutze ich sehr wohl Exceptions.

Luckie 8. Aug 2010 12:42
AW: Background Intelligent Transfer Service nutzen
 
Und was spricht dagegen im den Fehlercode zu prüfen und gegebenen falls eine Exception zu werfen? Guck dir doch den Spaghetti Code an der dabei rauskommt.

himitsu 8. Aug 2010 12:49
AW: Background Intelligent Transfer Service nutzen
 
in C/PHP ginge sowas :roll:

Code:
((($Result = AufrufFunktion1()) == S_OK) &&
 (($Result = AufrufFunktion2()) == S_OK) &&
 (($Result = AufrufFunktion3()) == S_OK) &&
 (($Result = AufrufFunktion4()) == S_OK) &&
 (($Result = AufrufFunktion5()) == S_OK));
return $Result;

HeikoAdams 9. Aug 2010 07:16
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
Zitat von Luckie (Beitrag 1040242)
Und was spricht dagegen im den Fehlercode zu prüfen und gegebenen falls eine Exception zu werfen? Guck dir doch den Spaghetti Code an der dabei rauskommt.
Du meinst, anstelle von
Delphi-Quellcode:
  if not Succeeded(Res) then
  begin
    aError := WideString(SysErrorMessage(Res));
    Exit;
  end;
sowas
Delphi-Quellcode:
  if not Succeeded(Res) then
    RaiseLastOSError;
?

HeikoAdams 9. Aug 2010 07:44
AW: Background Intelligent Transfer Service nutzen
 
Okay, dann halt mit Exceptions: :-D
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.

NormanNG 9. Aug 2010 07:49
AW: Background Intelligent Transfer Service nutzen
 
Hi,

könnte bitte einmal jemand zu #11 Stellung nehmen?
Ist wohl bei aller Exception-Reiterei etwas untergegangen.

HeikoAdams 9. Aug 2010 07:57
AW: Background Intelligent Transfer Service nutzen
 
Zitat:
Zitat von NormanNG (Beitrag 1040335)
Hi,
könnte bitte einmal jemand zu #11 Stellung nehmen?
Was soll denn an der Befüllung von DownloadInfo falsch sein?

himitsu 9. Aug 2010 08:03
AW: Background Intelligent Transfer Service nutzen
 
Delphi-Quellcode:
var
  DownloadInfo: PBgFileInfo
Das sieht nach einem Pointer aus, welchem aber kein Speicher zugewiesen wird.

HeikoAdams 9. Aug 2010 08:11
AW: Background Intelligent Transfer Service nutzen
 
Stimmt, das hab ich wohl übersehen :oops:
Um ehrlich zu sein, hatte ich auch noch keine Gelegenheit, die Funktion zu testen. Zur Sicherheit haben ich die Deklaration der Funktion um die Hinweis-Direktive
Delphi-Quellcode:
experimental
erweitert.

NormanNG 9. Aug 2010 08:28
AW: Background Intelligent Transfer Service nutzen
 
Hi,

ich habe wohl schon zu lange nicht mehr mit Delphi gearbeitet, :)
aber folgendes verstehe ich nicht:

Delphi-Quellcode:
  for nCount := Low(aURL) to High(aURL) do
  begin
    with Info do
    begin
      RemoteName := PWideChar(aUrl[nCount]);
      LocalName := PWideChar(aDest[nCount]);
    end;
  end;
Im ersten Durchlauf wird RemoteName der Pointer auf WideChar(aUrl[ Low(aURL) ]) zugewiesen.
Und im nächsten Durchlauf? Was bringt denn diese Schleife?
Sorry für die blöde Frage :oops:

mkinzler 9. Aug 2010 08:37
AW: Background Intelligent Transfer Service nutzen
 
So natürlich nichts, da die Variablen ja immer wieder überschriebn werden.

HeikoAdams 9. Aug 2010 08:49
AW: Background Intelligent Transfer Service nutzen
 
*gnarf* Das kommt davon, wenn man ohne Kaffee arbeitet 8-)

so sollte es jetzt passen:
Delphi-Quellcode:
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: array of BG_FILE_INFO;
  nCount: Integer;
begin
  if Assigned(CopyJob) then
    CopyJob := nil;

  if not Succeeded(GetNewJob(PWideChar(aDisplayName), aJobType, CopyJob)) then
    RaiseLastOSError;

  SetLength(Info, Length(aUrl));
  ZeroMemory(@Info, SizeOf(Info));

  for nCount := Low(aURL) to High(aURL) do
  begin
    with Info[nCount] 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);
  SetLength(Info, 0);
  CopyJob := nil;
end;

NormanNG 9. Aug 2010 08:54
AW: Background Intelligent Transfer Service nutzen
 
OK - dann ist meine Delphi-Welt ja wieder in Ordnung :-D

HeikoAdams 9. Aug 2010 12:53
AW: Background Intelligent Transfer Service nutzen
 
So, hier nochmal eine leicht modifizierte Version, in der noch ein paar Details geändert worden sind:
Delphi-Quellcode:
{*******************************************************}
{                                                       }
{       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.
Edit 10.07.2010: noch ein paar kleine Modifikationen eingefügt.

HeikoAdams 10. Aug 2010 14:19
AW: Background Intelligent Transfer Service nutzen
 
Einen hab ich noch:

SetNotifyInterface wird unterstützt, um z.B. Aktionen nach dem (erfolglosen) Download durchzuführen.

Delphi-Quellcode:
{*******************************************************}
{                                                       }
{       Unit for using Microsoft BITS                  }
{                                                       }
{       Copyright (C) 2010 Heiko Adams                 }
{                                                       }
{*******************************************************}

unit BackgroundCopyService;

interface

uses JwaWindows, ExtActns, Types, SysUtils;

type
  EInterfaceNotSet = Exception;
  cBackgroundCopyCallback = class(TObject, IUnknown, IBackgroundCopyCallback)
  private
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function JobTransferred(aJob: IBackgroundCopyJob): HResult; stdcall;
    function JobError(aJob: IBackgroundCopyJob; aError: IBackgroundCopyError): HResult; stdcall;
    function JobModification(aJob: IBackgroundCopyJob; aReserved: DWord): HResult; stdcall;
  end;

  TBackgroundCopyService = class
  private
    FAttempts: Byte;
    FJobId: TGUID;
    FNotifyFlags: Cardinal;
    CopyMngr: IBackgroundCopyManager;
    CopyJob: IBackgroundCopyJob;
    FCopyCallback: cBackgroundCopyCallback;

    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): HRESULT;
    function ExecuteAfterDownload: HResult;
  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;
    property CopyCallbackInterface: cBackgroundCopyCallback read FCopyCallback write FCopyCallback;
    property NotifyFlags: Cardinal read FNotifyFlags write FNotifyFlags;
  end;

  const errInterfaceNotSet = 'Could not set BackgroundCopyCallback Interface';

implementation

uses JclWin32, ComObj, JclSysInfo, ActiveX;

function cBackgroundCopyCallback._AddRef: Integer;
begin
  Result := 0;
end;

function cBackgroundCopyCallback._Release: Integer;
begin
  Result := 0;
end;

function cBackgroundCopyCallback.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if(GetInterface(IID,Obj)) then
  begin
    Result := 0
  end else
  begin
    Result := E_NOINTERFACE;
  end;
end;

function cBackgroundCopyCallback.JobTransferred(aJob: IBackgroundCopyJob): HResult;
begin
  Result := S_OK;
end;

function cBackgroundCopyCallback.JobError(aJob: IBackgroundCopyJob; aError: IBackgroundCopyError): HResult;
begin
  Result := S_OK;
end;

function cBackgroundCopyCallback.JobModification(aJob: IBackgroundCopyJob; aReserved: DWord): HResult;
begin
  Result := S_OK;
end;

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;
  nError: HRESULT;
begin
  nCount := 1;
  DownloadUrl(aURL, aDest, aDisplayName, BG_JOB_TYPE_UPLOAD);

  try
    repeat
      nError := ResumeJob(aDownloadFeedback);
      Result := (nError = S_OK);
      Inc(nCount);
    until Result or (nCount >= FAttempts);
  finally
    CopyJob := nil;
  end;

  if not Result then
    RaiseLastOSError(nError);
end;

function TBackgroundCopyService.DownloadFile(const aURL, aDest: WideString;
  const aDownloadFeedback: TDownloadProgressEvent;
  const aDisplayName: WideString): Boolean;
var
  nCount: Byte;
  nError: HRESULT;
begin
  nCount := 1;
  nError := S_OK;
  Result := True;
  DownloadUrl(aURL, aDest, aDisplayName, BG_JOB_TYPE_DOWNLOAD);

  try
    if Assigned(FCopyCallback) and
      not Succeeded(ExecuteAfterDownload) then
      raise EInterfaceNotSet.Create(errInterfaceNotSet);
     
    repeat
      nError := ResumeJob(aDownloadFeedback);
      Result := (nError = S_OK);
      Inc(nCount);
    until Result or (nCount >= FAttempts);
  finally
    CopyJob := nil;
  end;

  if not Result then
    RaiseLastOSError(nError);
end;

function TBackgroundCopyService.DownloadFiles(const aURL, aDest: TWideStringDynArray;
  const aDownloadFeedback: TDownloadProgressEvent;
  const aDisplayName: WideString): Boolean;
var
  nCount: Byte;
  nError: HRESULT;
begin
  nCount := 1;  
  nError := S_OK;
  Result := True;
  DownloadMultiUrl(aURL, aDest, aDisplayName, BG_JOB_TYPE_DOWNLOAD);

  try
    if Assigned(FCopyCallback) and
      not Succeeded(ExecuteAfterDownload) then
      raise EInterfaceNotSet.Create(errInterfaceNotSet);

    repeat
      nError := ResumeJob(aDownloadFeedback);
      Result := (nError = S_OK);
      Inc(nCount);
    until Result or (nCount >= FAttempts);
  finally
    CopyJob := nil;
  end;

  if not Result then
    RaiseLastOSError(nError);
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): HRESULT;
var
  JobStatus: BG_JOB_STATE;
  JobType: BG_JOB_TYPE;
  bSuccess: Boolean;
begin
  bSuccess := 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
    bSuccess := (JobStatus = BG_JOB_STATE_TRANSFERRED);

  if bSuccess then
  begin
    CopyJob.Complete;
    Result := S_OK;
  end
  else
    Result := 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;
const
  nPeriod: Word = 1000;
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, nPeriod, 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;

function TBackgroundCopyService.ExecuteAfterDownload: HResult;
begin
  Result := CopyJob.SetNotifyInterface(FCopyCallback);

  if Succeeded(Result) then
    CopyJob.SetNotifyFlags(FNotifyFlags);
end;

end.

Sharky 10. Aug 2010 17:29
AW: Background Intelligent Transfer Service nutzen
 
Hai Haiko,

ich glaube es wäre für die Lesbarkeit des Threads besser wenn Du deinen Quellcode nicht jedesmal komplett einträgst sondern als Datei anhängst.

Danke!

HeikoAdams 11. Aug 2010 07:31
AW: Background Intelligent Transfer Service nutzen
 
oki doki :-D


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:29 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz