文档章节

如何使用 URLOpenStream 函数 - 回复 "天泽" 的问题

涂孟超
 涂孟超
发布于 2014/09/26 15:33
字数 528
阅读 10
收藏 0

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.

 
 
 
 
 

 

 

  

本文转载自:http://www.cnblogs.com/del/archive/2010/04/09/1708619.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
私信 提问
专访王颖泽:国产数据库开源之路如何可控?

  【IT168 评论】中兴风波过后,大众对国产基础软件领域的关注倒是让不少厂商“受宠若惊”。“可控”成为公众对中国造的希望,开源面临的授权问题成为一颗悬在国产厂商头顶的达摩克利斯之剑...

it168网站
2018/05/07
0
0
刘强东涉嫌性侵案被警方证实,王思聪“看热闹”围观吐槽……

【侨报记者逸清、萧东9月2日洛杉矶报道】9月1日晚上12点44分,《侨报》在美国媒体中率先报道刘强东在明尼苏达州涉嫌性侵案。今天得到美联社、纽约时报等媒体证实,而且刘强东的监狱照已曝光。...

程序员之家_
2018/09/03
0
0
杨泽业:给你的wordpress博客添加SMTP邮件服务,评论以后邮件通知

当你的博客有人评论的时候,就会收到邮件通知,那是非常好的体验,有人评论了自己第一时间知晓。特别是,有人在你的博客留言,需要有人解答问题的时候,这个人是迫切的需要及时通知的,有的评...

泽业建站网
2018/06/29
0
0
e-pos的租赁问题

@wushunlian 你好,想跟你请教个问题: 我下载了你在sourceforge.net上的项目,epos0.7,使用很方便。现在遇到一个问题,在会员租赁中,计算的最小单位是天,请问如何改成小时呢? 我下载了源...

caixianyu
2012/12/25
104
2
Gmail推出了属于用户自己的数据分析功能,简直棒极了

  Gmail现在在全世界有超过10亿月度活跃用户,因为它免费、快捷、可靠、并且提供几乎无限量的存储空间。操作方便,对于企业和个人用户来说都是如此。   但是用户共同的痛点也是很明显的:...

36氪
2018/02/25
0
0

没有更多内容

加载失败,请刷新页面

加载更多

tac 与cat

tac从后往前看文件,结合grep使用

writeademo
53分钟前
2
0
表单中readonly和dsabled的区别

这两种写法都会使显示出来的文本框不能输入文字, 但disabled会使文本框变灰,而且通过通过表单提交时,获取不到文本框中的value值(如果有的话), 而readonly只是使文本框不能输入,外观没...

少年已不再年少
今天
2
0
SpringBoot上传图片操作

首先有个上传文件的工具类 /** * 文件上传 * @param file * @param filePath * @param fileName * @throws Exception */public static void uploadFile(byte[] file, String ...

_liucui_
今天
6
0
DrawerLayout

public class MainActivity extends BaseActivity implements NavigationView.OnNavigationItemSelectedListener,OnFragmentInteractionListener{ public NavigationView navView; ......

安卓工程师王恒
今天
2
0
python精简笔记

python精简笔记-字符串基本用法 字符串常见用法: * encode() # 编码成bytes类型 * find() # 查找子串 * index() # 获取下标 * replace() # 替换子串 * len(string) # 返回字符串长度,...

平头哥-Enjoystudy
今天
1
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部