Datei downloaden (mit Fortschrittsanzeige)

    Zitat von Icewarez

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


    Code
    uses  UrlMon, ActiveX;


    Zitat von Icewarez

    Dann wird folgender Typ deklariert:



    Code
    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;



    Zitat von Icewarez

    Dann brauchen wir noch eine Variable:



    Code
    var  Form1: TForm1;  usercancel: Boolean = False;




    Zitat von Icewarez

    Jetzt kommen wir zur Implementation:



    Code
    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;




    Zitat von Icewarez

    Und zu guter Letzt kommen wir zum Herunterladen: