[b]
unit[/b] Unit1;
[b]interface[/b]
[b]uses[/b]
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UrlMon, StdCtrls, ComCtrls, ComObj,
ActiveX, ComServ;
[b]type[/b]
TDownloadCallback = [b]class[/b](TCOMObject, IBindStatusCallback)
[b]function[/b] OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; [b]stdcall[/b];
[b]function[/b] GetPriority([b]out[/b] nPriority): HResult; [b]stdcall[/b];
[b]function[/b] OnLowResource(reserved: DWORD): HResult; [b]stdcall[/b];
[b]function[/b] OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult; [b]stdcall[/b];
[b]function[/b] OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; [b]stdcall[/b];
[b]function[/b] GetBindInfo([b]out[/b] grfBINDF: DWORD; [b]var[/b] bindinfo: TBindInfo): HResult; [b]stdcall[/b];
[b]function[/b] OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
stgmed: PStgMedium): HResult; [b]stdcall[/b];
[b]function[/b] OnObjectAvailable([b]const[/b] iid: TGUID; punk: IUnknown): HResult; [b]stdcall[/b];
[b]end[/b];
[b]type[/b]
TForm1 = [b]class[/b](TForm)
ProgressBar: TProgressBar;
Button: TButton;
[b]procedure[/b] ButtonClick(Sender: TObject);
[b]procedure[/b] FormCreate(Sender: TObject);
[b]private[/b]
[color=#000080][i]{ Private declarations }[/i][/color]
dlc: TDownloadCallback;
[b]public[/b]
[color=#000080][i]{ Public declarations }[/i][/color]
[b]end[/b];
[b]var[/b]
Form1: TForm1;
[b]implementation[/b]
[color=#008000]{$R *.dfm}[/color]
[b]function[/b] TDownloadCallback.OnStartBinding(dwReserved: DWORD;
pib: IBinding): HResult; [b]stdcall[/b];
[b]begin[/b]
Form1.ProgressBar.Position := [color=#000080]0[/color];
Result := S_OK;
[b]end[/b];
[b]function[/b] TDownloadCallback.GetPriority([b]out[/b] nPriority): HResult; [b]stdcall[/b];
[b]begin[/b]
Result := E_NOTIMPL;
[b]end[/b];
[b]function[/b] TDownloadCallback.OnLowResource(reserved: DWORD): HResult; [b]stdcall[/b];
[b]begin[/b]
Result := E_NOTIMPL;
[b]end[/b];
[b]function[/b] TDownloadCallback.OnProgress(ulProgress, ulProgressMax,
ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; [b]stdcall[/b];
[b]begin[/b]
Form1.ProgressBar.Max := ulProgressMax;
Form1.ProgressBar.Position := ulProgress;
Application.ProcessMessages();
Result := S_OK;
[color=#000080][i]// to cancel, return E_ABORT instead of S_OK[/i][/color]
[b]end[/b];
[b]function[/b] TDownloadCallback.OnStopBinding(hresult: HResult;
szError: LPCWSTR): HResult; [b]stdcall[/b];
[b]begin[/b]
Result := E_NOTIMPL;
[b]end[/b];
[b]function[/b] TDownloadCallback.GetBindInfo([b]out[/b] grfBINDF: DWORD;
[b]var[/b] bindinfo: TBindInfo): HResult; [b]stdcall[/b];
[b]begin[/b]
Result := E_NOTIMPL;
[b]end[/b];
[b]function[/b] TDownloadCallback.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD;
formatetc: PFormatEtc; stgmed: PStgMedium): HResult; [b]stdcall[/b];
[b]begin[/b]
Result := E_NOTIMPL;
[b]end[/b];
[b]function[/b] TDownloadCallback.OnObjectAvailable([b]const[/b] iid: TGUID;
punk: IUnknown): HResult; [b]stdcall[/b];
[b]begin[/b]
Result := E_NOTIMPL;
[b]end[/b];
[b]procedure[/b] TForm1.ButtonClick(Sender: TObject);
[b]begin[/b]
UrlDownloadToFile([b]nil[/b], [color=#000080]'http://www.delphipraxis.net/viewtopic.php?t=2801'[/color],
[color=#000080]'C:\UrlDownloadToFile.html'[/color], [color=#000080]0[/color], dlc);
[b]end[/b];
[b]procedure[/b] TForm1.FormCreate(Sender: TObject);
[b]begin[/b]
dlc := TDownloadCallback.Create();
[b]end[/b];
[b]initialization[/b]
TComObjectFactory.Create(ComServer, TDownloadCallback, IBindStatusCallback,
[color=#000080]'TDownloadCallback'[/color],
[color=#000080]'Callback Interface for UrlDownloadToFile()'[/color],
ciMultiInstance, tmApartment);
[b]end[/b].