IBindStatusCallBack - Jak uzyskać ProgessBar do funkcji UrlDownloadToFile
cyberdemon
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 ;)