AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi Background Intelligent Transfer Service nutzen

Background Intelligent Transfer Service nutzen

Ein Thema von HeikoAdams · begonnen am 6. Aug 2010 · letzter Beitrag vom 11. Aug 2010
Antwort Antwort
Seite 3 von 3     123
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#21

AW: Background Intelligent Transfer Service nutzen

  Alt 9. Aug 2010, 09:11
Stimmt, das hab ich wohl übersehen
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 experimental erweitert.
Jeder kann ein Held werden und Leben retten!
Einfach beim NKR oder der DKMS als Stammzellenspender registrieren! Also: worauf wartest Du noch?
  Mit Zitat antworten Zitat
NormanNG

Registriert seit: 1. Feb 2006
294 Beiträge
 
Delphi 2007 Professional
 
#22

AW: Background Intelligent Transfer Service nutzen

  Alt 9. Aug 2010, 09:28
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
Gruß
Norman
  Mit Zitat antworten Zitat
mkinzler
(Moderator)

Registriert seit: 9. Dez 2005
Ort: Heilbronn
39.794 Beiträge
 
Delphi 10.4 Sydney
 
#23

AW: Background Intelligent Transfer Service nutzen

  Alt 9. Aug 2010, 09:37
So natürlich nichts, da die Variablen ja immer wieder überschriebn werden.
Markus Kinzler
  Mit Zitat antworten Zitat
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#24

AW: Background Intelligent Transfer Service nutzen

  Alt 9. Aug 2010, 09:49
*gnarf* Das kommt davon, wenn man ohne Kaffee arbeitet

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;
Jeder kann ein Held werden und Leben retten!
Einfach beim NKR oder der DKMS als Stammzellenspender registrieren! Also: worauf wartest Du noch?

Geändert von HeikoAdams ( 9. Aug 2010 um 10:11 Uhr)
  Mit Zitat antworten Zitat
NormanNG

Registriert seit: 1. Feb 2006
294 Beiträge
 
Delphi 2007 Professional
 
#25

AW: Background Intelligent Transfer Service nutzen

  Alt 9. Aug 2010, 09:54
OK - dann ist meine Delphi-Welt ja wieder in Ordnung
Gruß
Norman
  Mit Zitat antworten Zitat
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#26

AW: Background Intelligent Transfer Service nutzen

  Alt 9. Aug 2010, 13:53
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.
Jeder kann ein Held werden und Leben retten!
Einfach beim NKR oder der DKMS als Stammzellenspender registrieren! Also: worauf wartest Du noch?

Geändert von HeikoAdams (10. Aug 2010 um 10:20 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#27

AW: Background Intelligent Transfer Service nutzen

  Alt 10. Aug 2010, 15:19
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.
Jeder kann ein Held werden und Leben retten!
Einfach beim NKR oder der DKMS als Stammzellenspender registrieren! Also: worauf wartest Du noch?
  Mit Zitat antworten Zitat
Benutzerbild von Sharky
Sharky

Registriert seit: 29. Mai 2002
Ort: Frankfurt
8.248 Beiträge
 
Delphi 2006 Professional
 
#28

AW: Background Intelligent Transfer Service nutzen

  Alt 10. Aug 2010, 18:29
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!
Stephan B.
"Lasst den Gänsen ihre Füßchen"
  Mit Zitat antworten Zitat
Benutzerbild von HeikoAdams
HeikoAdams

Registriert seit: 12. Jul 2004
Ort: Oberfranken
661 Beiträge
 
FreePascal / Lazarus
 
#29

AW: Background Intelligent Transfer Service nutzen

  Alt 11. Aug 2010, 08:31
oki doki
Jeder kann ein Held werden und Leben retten!
Einfach beim NKR oder der DKMS als Stammzellenspender registrieren! Also: worauf wartest Du noch?
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +2. Es ist jetzt 00:07 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf