如何使用 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 := 'https://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.