Цитата(MetalFan @ 5.8.2007, 16:54  ) | | Yanis, а что от TObject, а не от TInterfacedObject, как Alexeis? ихо так нагляднее) нет лишнего кода |
Ну да, так разумнее. Не внимательный потому что, вот и ляпаю 
Добавлено @ 16:40
Реализация класса TBindStatusCallback:
| Код | TBindStatusCallback = class(TInterfacedObject, IBindStatusCallback) |
| Код | unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, UrlMon, StdCtrls;
type
TOnProgressEvent = procedure(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR) of object;
TBindStatusCallback = class(TInterfacedObject, IBindStatusCallback)
private
FOnProgress: TOnProgressEvent;
published
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;
property OnDownload: TOnProgressEvent read FOnProgress write FOnProgress;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function DownloadFile(SourceFile, DestFile: string; DownloadEvent: TOnProgressEvent): Boolean;
procedure Download(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TBindStatusCallback }
function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD;
var bindinfo: TBindInfo): HResult;
begin
Result := E_NOTIMPL;
end;
function TBindStatusCallback.GetPriority(out nPriority): HResult;
begin
Result := E_NOTIMPL;
end;
function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
Result := E_NOTIMPL;
end;
function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
Result := E_NOTIMPL;
end;
function TBindStatusCallback.OnObjectAvailable(const iid: TGUID;
punk: IInterface): HResult;
begin
Result := E_NOTIMPL;
end;
function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax,
ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
if Assigned(FOnProgress) then
FOnProgress(ulProgress, ulProgressMax, ulStatusCode, szStatusText);
Result := S_OK;
end;
function TBindStatusCallback.OnStartBinding(dwReserved: DWORD;
pib: IBinding): HResult;
begin
Result := E_NOTIMPL;
end;
function TBindStatusCallback.OnStopBinding(hresult: HResult;
szError: LPCWSTR): HResult;
begin
Result := E_NOTIMPL;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
DownloadFile('http://torrent.borland.com/turbodelphi_en.iso.zip',
'c:\tmp\turbodelphi_en.iso.zip', Download);
end;
procedure TForm1.Download(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR);
begin
Caption := Format('%d of %d bytes (%s)', [ulProgress, ulProgressMax, szStatusText]);
Application.ProcessMessages;
end;
function TForm1.DownloadFile(SourceFile, DestFile: string;
DownloadEvent: TOnProgressEvent): Boolean;
var
status: TBindStatusCallback;
begin
try
status := TBindStatusCallback.Create;
status.OnDownload := DownloadEvent;
Result := UrlDownloadToFile(nil,
PChar(SourceFile),
PChar(DestFile),
0,
status) = 0;
status.Free;
except
Result := False;
end;
end;
end.
|
Отдельное спасибо MetalFan за пинок. |
