Question

如何使用 URLOpenStream 函数

Answer 1

URLOpenStream 和 URLDownloadToFile 类似, 都是下载文件的 COM 函数;
前者是下载到 IStream 流, 后者是直接下载到指定路径;
它们都声明在 UrlMon 单元, 本例还要同时 uses ActiveX, 因为要用到 IStream 接口.
function URLOpenStream(
p1: IUnknown; { 接口, 不用它, 给 nil 即可 }
p2: PWideChar; { 要下载的路径 }
p3: DWORD; { 暂未使用的参数, 须是 0 }
p4: IBindStatusCallback { 接口, 下载后的数据得给它要; 我们需要实现它 }
): HResult; stdcall; { 返回 S_OK 表示成功, 本例是使用了 Succeeded 函数判断的 }

IBindStatusCallback 接口有八个方法(或事件), 用到用不到都得给简单实现下;
我们主要实现的是其中的 OnDataAvailable, 因为下载后的数据是通过其 stgmed 参数返回的.

下面是实现及测试代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, UrlMon, ActiveX;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

TBindStatusCallback = class(TInterfaceList, 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;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
url: string;
MyBindStatusCallback: IBindStatusCallback;
begin
Button1.Caption := '正在下载...';
Button1.Enabled := False;

url := 'http: //xxx';
MyBindStatusCallback := TBindStatusCallback.Create;
if Succeeded(URLOpenStream(nil, PChar(url), 0, MyBindStatusCallback)) then
Button1.Caption := '下载完毕!'
else
Button1.Caption := '下载失败!';

Button1.Enabled := True;
end;

{ TBindStatusCallback }

function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD;
var bindinfo: TBindInfo): HResult;
begin
Result := S_OK;
end;

function TBindStatusCallback.GetPriority(out nPriority): HResult;
begin
Result := S_OK;
end;

function TBindStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
var
Stream: IStream;
mem: TMemoryStream;
begin
if dwSize > 0 then
begin
Stream := IStream(stgmed.stm);
mem := TMemoryStream.Create;
mem.SetSize(dwSize);
Stream.Read(mem.Memory, dwSize, nil);
//ShowMessage(IntToStr(mem.Size));
mem.SaveToFile('C:\Temp\PMark_1.rar');
mem.Free;
Result := S_OK;
end else Result := E_ABORT;
end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
Result := S_OK;
end;

function TBindStatusCallback.OnObjectAvailable(const iid: TGUID;
punk: IInterface): HResult;
begin
Result := S_OK;
end;

function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax,
ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
//如果需要下载进度就在这里写代码
Result := S_OK;
end;

function TBindStatusCallback.OnStartBinding(dwReserved: DWORD;
pib: IBinding): HResult;
begin
Result := S_OK;
end;

function TBindStatusCallback.OnStopBinding(hresult: HResult;
szError: LPCWSTR): HResult;
begin
Result := S_OK;
end;

end.