IBindStatusCallBack - Jak uzyskać ProgessBar do funkcji UrlDownloadToFile
Jak uzyskać ProgessBar do funkcji UrlDownloadToFile? - interfejs IBindStatusCallBack.
Poniżej podaję gotowe rozwiązanie (właściwie cały program), wraz z porzebnymi komentarzami:
Typy danych są konkretnie pod Delphi7, w innych wersjach typy danych w definicjach funkcji mogą się różnić. Przykładowo pod Delphi 3 opis interfejsu będzie nieco się różnił typami danych, należy wtedy użyć takich samych typów jakie są opisane w pliku UrlMon.pas
unit Unit1; interface uses {w sekcji uses musimy zadelkarować dodatkowo te dwa moduły} UrlMon, ActiveX; type {w module UrlMon jest już zdefiniowany interfejs IBindStatusCallback, niestety nie możemy go użyć w takiej formie jakiej jest, musimy zdefiniować nowy interfejs pokrywając tylko jego metody. Do rozwiązania potrzebna nam jest funkcja OnProgress, reszta może nic nie robić, ale muszą być zdefiniowane} TStatusCallback = class (TObject, IBindStatusCallback) public 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; {poniższe fukcje nie są opisane w interfejsie IBindStatusCallback w module UrlMon (plik UrlMon.pas) ale są wymagane przez Delphi w opise każdego interfejsu, bez tego się nie skompliluje} function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; end; TForm1 = class(TForm) ProgressBar1: TProgressBar; Button1: TButton; Edit1: TEdit; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function TStatusCallback.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall; begin result:=0; end; function TStatusCallback.GetPriority(out nPriority): HResult; stdcall; begin result:=0; end; function TStatusCallback.OnLowResource(reserved: DWORD): HResult; stdcall; begin result:=0; end; function TStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall; begin {tu wykonujemy potrzebne zadania} Form1.ProgressBar1.Max:=ulProgressMax; Form1.ProgressBar1.Position:=ulProgress; result:=0; end; function TStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall; begin Form1.Edit1.Text:='Zakonczono pobieranie'; result:=0; end; function TStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall; begin result:=0; end; function TStatusCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall; begin result:=0; end; function TStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall; begin result:=0; end; function TStatusCallback._AddRef: Integer; begin end; function TStatusCallback._Release: Integer; begin end; function TStatusCallback.QueryInterface(const IID: TGUID; out Obj): HRESULT; begin end; procedure TForm1.Button1Click(Sender: TObject); var StatusCallback : TStatusCallback; begin StatusCallBack:=TStatusCallback.Create; {tworzymy interfejs StatusCallback} UrlDownloadToFile(nil, PChar('http://www.strona.pl/pobierany_plik.ext'), PChar('C:\pobierany_plik.ext'), 0, StatusCallBack); {wywołujemy pobieranie} StatusCallBack.Free; {zwalniamy interfejs} end; end.
Przydatne ;)