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://files.cnblogs.com/del/PMark_1.rar'';　
　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.　(责任编辑：admin)