Datei downloaden (mit Fortschrittsanzeige)

  • Zitat von Icewarez

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


    Code
    1. uses UrlMon, ActiveX;


    Zitat von Icewarez

    Dann wird folgender Typ deklariert:



    Code
    1. 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
    1. var Form1: TForm1; usercancel: Boolean = False;




    Zitat von Icewarez

    Jetzt kommen wir zur Implementation:



    Code
    1. 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: