如何使用 URLOpenStream 函數

　　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.