文档章节

如何使用 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网站
05/07
0
0
刘强东涉嫌性侵案被警方证实,王思聪“看热闹”围观吐槽……

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

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

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

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

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

caixianyu
2012/12/25
89
2
VC++常用数据类型及其操作详解(非常经典,共同分享)

友情提示: 为了方便你更好的学习和阅读,也更好的体现尊重原创作者的劳动成果,请您直接查看转载原本链接: http://snailflying.blog.hexun.com/8219350d.html ==========================...

长平狐
2013/01/06
1K
0

没有更多内容

加载失败,请刷新页面

加载更多

Alibaba Java诊断利器Arthas实践--使用redefine排查应用奇怪的日志来源

背景 随着应用越来越复杂,依赖越来越多,日志系统越来越混乱,有时会出现一些奇怪的日志,比如: [] [] [] No credential found 那么怎样排查这些奇怪的日志从哪里打印出来的呢?因为搞不清...

hengyunabc
今天
1
0
home hosts

home hosts lwk@qwfys:~$ cat /etc/hosts127.0.0.1 localhost127.0.1.1 qwfys192.168.56.101vm600.qwfys.com39.108.212.91alpha1.ppy.com39.108.117.122alpha2.p......

qwfys
今天
1
0
大数据教程(6.1)hadoop生态圈介绍及就业前景

1. HADOOP背景介绍 1.1、什么是HADOOP 1.HADOOP是apache旗下的一套开源软件平台 2.HADOOP提供的功能:利用服务器集群,根据用户的自定义业务逻辑,对海量数据进行分布式处理 3.HADOOP的核心组...

em_aaron
今天
4
0
hadoop垃圾回收站

在生产生,hdfs回收站必须是开启的,一般设置为7天。 fs.trash.interval 为垃圾回收站保留时间,如果为0则禁用回收站功能。 fs.trash.checkpoint.interval 回收站检查点时间,一般设置为小于...

hnairdb
昨天
3
0
腾讯与Github的魔幻会面背后的故事…

10月22日,腾讯开源管理办公室有幸邀请到Github新晋CEO Nat Friedman,前来鹅厂参观交流。目前腾讯已经有近70个项目在Github上开源,共获得17w stars,世界排名11位。Github是腾讯开源的主阵...

腾讯开源
昨天
19
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部