Datei downloaden (mit Fortschrittsanzeige)

[DeCodeGuru]

Erst mal in den Uses UrlMon und ActiveX hinzufügen:

Delphi-Quellcode:

uses
  UrlMon, ActiveX;

Dann wird folgender Typ deklariert:

Delphi-Quellcode:

type
  cDownloadStatusCallback = class(TObject,IUnknown,IBindStatusCallback)
  private
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
  end;

Dann brauchen wir noch eine Variable:

Delphi-Quellcode:

var
  Form1: TForm1;
  usercancel: Boolean = False;

Jetzt kommen wir zur Implementation:

Delphi-Quellcode:

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

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

function cDownloadStatusCallback.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 cDownloadStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
begin
  Result := S_OK;
end;

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  case ulStatusCode of
    BINDSTATUS_FINDINGRESOURCE:
    begin
      Form1.Label1.Caption := 'Datei wurde gefunden...';
      if (usercancel) then
      begin
        Result := E_ABORT;
        exit;
      end;
    end;
    BINDSTATUS_CONNECTING:
    begin
      Form1.Label1.Caption := 'Es wird verbunden...';
      if (usercancel) then
      begin
        Result := E_ABORT;
        exit;
      end;
    end;
    BINDSTATUS_BEGINDOWNLOADDATA:
    begin
      Form1.Gauge1.Progress := 0;
      Form1.Label1.Caption := 'Der Download wurde gestartet...';
      if (UserCancel) then
      begin
        Result := E_ABORT;
        exit;
      end;
    end;
    BINDSTATUS_DOWNLOADINGDATA:
    begin
      Form1.Gauge1.Progress := MulDiv(ulProgress,100,ulProgressMax);
      Form1.Label1.Caption := 'Datei wird heruntergeladen...';
      if (UserCancel) then
      begin
        Result := E_ABORT; exit;
      end;
    end;
    BINDSTATUS_ENDDOWNLOADDATA:
    begin
      Form1.Label1.Caption := 'Download wurd beendet...';
    end;
  end;
  Application.ProcessMessages;

  Result := S_OK;
end;

Und zu guter Letzt kommen wir zum Herunterladen:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  cDownStatus : cDownloadStatusCallback;
  status: integer;
begin
  cDownStatus := cDownloadStatusCallBack.Create;
  
   status := URLDownloadToFIle(nil,'http://www.google.de/index.html',
     'C:\index.html',0,CDownStatus);
    cDownStatus.Free;

   if (status <> 0) then
      Form1.Label1.Caption:='Es gab einen Fehler beim Herunterladen!';
end;

So, das wars!!

MfG DeCodeGuru

[edit=Chakotay1308]Einige Erweiterungen von MathiasSimmack implementiert. Mfg, Chakotay1308[/edit]
[edit=fkerber] Mfg, fkerber[/edit]

[MathiasSimmack]

Machen wir nur noch die Erweiterung für NonVCL, denn mein Setup ist ein solches:

Delphi-Quellcode:

function cDownloadStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var
  szST : string;
begin
  case ulStatusCode of
    BINDSTATUS_BEGINDOWNLOADDATA:
      begin
        // reset progressbar
        SendMessage(GetDlgItem(hDlg,IDC_PROGRESS),PBM_SETPOS,0,0);

        // show current action
        szST := szStatusText;
        SendMessage(GetDlgItem(hDlg,IDC_ACTIONTEXT),WM_SETTEXT,0,integer(szST));

        // download exit by the user?
        if(m_fUserCancel) then
          begin
            Result := E_ABORT; exit;
          end;
      end;
    BINDSTATUS_DOWNLOADINGDATA:
      begin
        // update progress
        SendMessage(GetDlgItem(hDlg,IDC_PROGRESS),PBM_SETPOS,MulDiv(ulProgress,100,ulProgressMax),0);

        // download exit by the user?
        if(m_fUserCancel) then
          begin
            Result := E_ABORT; exit;
          end;
      end;
    BINDSTATUS_ENDDOWNLOADDATA:
      SendMessage(hDlg,WM_CLOSE,0,0); // close Download dialog
  end;

  // message pump
  if(PeekMessage(msg,hDlg,0,0,PM_REMOVE)) then IsDialogMessage(hDlg,msg);

  Result := S_OK; // default result
end;

[edit=Chakotay1308]Auf das Wesentliche gekürzt. Mfg, Chakotay1308[/edit]