UrlDownloadFile, 线程下载文件, 带进度条
unit FileDownLoadThread;
interface
uses
Classes,
SysUtils,
Windows,
ActiveX,
UrlMon;
const
S_ABORT = HRESULT($); type
TFileDownLoadThread = class;
TDownLoadProcessEvent = procedure(Sender: TFileDownLoadThread; Progress, ProgressMax: Cardinal) of object;
TDownLoadCompleteEvent = procedure(Sender: TFileDownLoadThread) of object;
TDownLoadFailEvent = procedure(Sender: TFileDownLoadThread; Reason: LongInt) of object;
TDownLoadMonitor = class(TInterfacedObject, IBindStatusCallback)
private
FShouldAbort: Boolean;
FThread: TFileDownLoadThread;
protected
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;
public
constructor Create(AThread: TFileDownLoadThread);
property ShouldAbort: Boolean read FShouldAbort write FShouldAbort;
end;
TFileDownLoadThread = class(TThread)
private
FSourceURL: string;
FSaveFileName: string;
FProgress, FProgressMax: Cardinal;
FOnProcess: TDownLoadProcessEvent;
FOnComplete: TDownLoadCompleteEvent;
FOnFail: TDownLoadFailEvent;
FMonitor: TDownLoadMonitor;
protected
procedure Execute; override;
procedure UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText: string);
procedure DoUpdateUI;
public
constructor Create(ASrcURL, ASaveFileName: string; AProgressEvent: TDownLoadProcessEvent = nil; ACompleteEvent: TDownLoadCompleteEvent = nil; AFailEvent: TDownLoadFailEvent = nil; CreateSuspended: Boolean = False);
property SourceURL: string read FSourceURL;
property SaveFileName: string read FSaveFileName;
property OnProcess: TDownLoadProcessEvent read FOnProcess write FOnProcess;
property OnComplete: TDownLoadCompleteEvent read FOnComplete write FOnComplete;
property OnFail: TDownLoadFailEvent read FOnFail write FOnFail;
end;
implementation constructor TDownLoadMonitor.Create(AThread: TFileDownLoadThread);
begin
inherited Create;
FThread := AThread;
FShouldAbort := False;
end; function TDownLoadMonitor.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
begin
result := S_OK;
end; function TDownLoadMonitor.GetPriority(out nPriority): HResult;
begin
Result := S_OK;
end; function TDownLoadMonitor.OnDataAvailable(grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
Result := S_OK;
end; function TDownLoadMonitor.OnLowResource(reserved: DWORD): HResult;
begin
Result := S_OK;
end; function TDownLoadMonitor.OnObjectAvailable(const iid: TGUID; punk: IInterface): HResult;
begin
Result := S_OK;
end; function TDownLoadMonitor.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
if FThread <> nil then FThread.UpdateProgress(ulProgress, ulProgressMax, ulStatusCode, '');
if FShouldAbort then Result := E_ABORT else Result := S_OK;
end; function TDownLoadMonitor.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
Result := S_OK;
end; function TDownLoadMonitor.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
Result := S_OK;
end;
{ TFileDownLoadThread } constructor TFileDownLoadThread.Create(ASrcURL, ASaveFileName: string; AProgressEvent: TDownLoadProcessEvent; ACompleteEvent: TDownLoadCompleteEvent; AFailEvent: TDownLoadFailEvent; CreateSuspended: Boolean);
begin
if (@AProgressEvent = nil) or (@ACompleteEvent = nil) or (@AFailEvent = nil) then CreateSuspended := True;
inherited Create(CreateSuspended);
FSourceURL := ASrcURL;
FSaveFileName := ASaveFileName;
FOnProcess := AProgressEvent;
FOnComplete := ACompleteEvent;
FOnFail := AFailEvent;
end; procedure TFileDownLoadThread.DoUpdateUI;
begin
if Assigned(FOnProcess) then FOnProcess(Self, FProgress, FProgressMax);
end; procedure TFileDownLoadThread.Execute;
var
DownRet: HRESULT;
begin
inherited;
FMonitor := TDownLoadMonitor.Create(Self);
DownRet := URLDownloadToFile(nil, PAnsiChar(FSourceURL), PAnsiChar(FSaveFileName), , FMonitor as IBindStatusCallback);
if DownRet = S_OK then begin
if Assigned(FOnComplete) then FOnComplete(Self);
end else begin
if Assigned(FOnFail) then FOnFail(Self, DownRet);
end;
FMonitor := nil;
end; procedure TFileDownLoadThread.UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText: string);
begin
FProgress := Progress;
FProgressMax := ProgressMax;
Synchronize(DoUpdateUI);
if Terminated then FMonitor.ShouldAbort := True;
end;
end. //使用 复制代码
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, UrlMon, FileDownLoadThread; type
TfrmDownloadFile = class(TForm)
btn1: TButton;
pb1: TProgressBar;
lbl1: TLabel;
lbl2: TLabel;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
aRunThread: TFileDownLoadThread;
public
SourceFile, DestFile: string;
procedure DownLoadProcessEvent(Sender: TFileDownLoadThread; Progress, ProgressMax: Cardinal);
procedure DownLoadCompleteEvent(Sender: TFileDownLoadThread);
procedure DownLoadFailEvent(Sender: TFileDownLoadThread; Reason: LongInt);
end; var
frmDownloadFile: TfrmDownloadFile; implementation {$R *.dfm} procedure TfrmDownloadFile.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(Handle, false), , , '程序: 花太香, QQ号: 2111971');
end; procedure TfrmDownloadFile.btn1Click(Sender: TObject);
begin
SourceFile := 'http://toolbar.soso.com/T4/download/QQToolbarInstaller.exe';
DestFile := '.\QQToolbarInstaller.exe';
lbl1.Caption := '0/0';
lbl2.Caption := '';
pb1.Position := ;
lbl2.Caption := '正在下载:' + ExtractFileName(DestFile);
aRunThread := TFileDownLoadThread.Create(SourceFile, DestFile, DownLoadProcessEvent, DownLoadCompleteEvent, DownLoadFailEvent, False);
end; procedure TfrmDownloadFile.DownLoadProcessEvent(
Sender: TFileDownLoadThread; Progress, ProgressMax: Cardinal);
var
z, z1: Single;
s, s1: string;
begin
pb1.Position := Progress;
pb1.Max := ProgressMax;
if (pb1.Max > ) then
begin
if pb1.Max > * then begin
z := pb1.Max / ( * );
s := 'MB';
end else begin
z := pb1.Max / ();
s := 'KB';
end; if Progress > * then begin
z1 := Progress / ( * );
s1 := 'MB';
end else begin
z1 := Progress / ();
s1 := 'KB';
end;
lbl1.Caption := Format('%.2n' + s1 + ' / %.2n' + s, [z1, z]);
end;
end; procedure TfrmDownloadFile.DownLoadCompleteEvent(
Sender: TFileDownLoadThread);
begin
lbl2.Caption := '下载完成.';
lbl1.Caption := '';
end; procedure TfrmDownloadFile.DownLoadFailEvent(Sender: TFileDownLoadThread; Reason: Integer);
begin
lbl2.Caption := '下载文件失败,请重试!';
end;
复制代码
end.
http://www.cnblogs.com/jxgxy/archive/2011/05/11/2043703.html
UrlDownloadFile, 线程下载文件, 带进度条的更多相关文章
- webclient下载文件 带进度条
private void button1_Click(object sender, EventArgs e) { doDownload(textBox1.Text.Trim()); } private ...
- Asp.Net上传大文件带进度条swfupload
Asp.Net基于swfupload上传大文件带进度条百分比显示,漂亮大气上档次,大文件无压力,先看效果 一.上传效果图 1.上传前界面:图片不喜欢可以自己换 2.上传中界面:百分比显示 3.上传后返 ...
- C# WPF 解压缩7zip文件 带进度条 sevenzipsharp
vs2013附件 :http://download.csdn.net/detail/u012663700/7427461 C# WPF 解压缩7zip文件 带进度条 sevenzipsharp W ...
- VC下载文件显示进度条
VC下载文件显示进度条 逗比汪星人2009-09-18上传 by Koma http://blog.csd.net/wangningyu http://download.csdn.net/deta ...
- Android开发(24)---安卓中实现多线程下载(带进度条和百分比)
当我们学完java中多线程的下载后,可以将它移植到我们的安卓中来,下面是具体实现源码: DownActivity.java package com.example.downloads; import ...
- Extjs 使用fileupload插件上传文件 带进度条显示
一.首先我们看看官方给出的插件的解释: 一个文件上传表单项具有自定义的样式,并且可以控制按钮的文本和 像文本表单的空文本类似的其他特性. 它使用一个隐藏的文件输入元素,并在用户选择文件后 在form提 ...
- VC下载文件 + 显示进度条
在codeproject里找了许久,发现这样一个VC下载文件并显示进度条的源码,于是添加了些中文注释: 1.下载线程函数: UINT DownloadFile(LPVOID pParam) { CWn ...
- asp.net mvc 实现上传文件带进度条
本文乃是博主早期写的,此种思路虽然实现了,但固然不是最好的,仅做参考学习. 可以用js onprogress .fileinput .webuploader.jq ajaxsubmit等实现 思路:a ...
- ASP.NET Jquery+ajax上传文件(带进度条)
效果图 支持ie6+,chrome,ie6中文文件名会显示乱码. 上传时候会显示进度条. 需要jquery.uploadify.js插件,稍后会给出下载 前台代码 <%@ Page Langua ...
随机推荐
- zoj 3772 Calculate the Function
http://acm.zju.edu.cn/onlinejudge/showProblem.do?problemId=5235 这道题需要构造矩阵:F(X)=F(X-1)+F(X-2)*A(X)转化为 ...
- 【转】ubuntu安装ftp服务器
原文网址:https://wiki.archlinux.org/index.php/Very_Secure_FTP_Daemon_(%E7%AE%80%E4%BD%93%E4%B8%AD%E6%96% ...
- c++ 06
一.下标操作符 A a (...); cout << a[3] << endl; cout << a.operator[] (3) << endl; c ...
- 简单的div蒙层
;;;; } $("#userLogin").click(function () { var heights = (parseInt($(window). ...
- Angular学习笔记(2)——TODO小应用
Angular学习笔记(2)--TODO小应用 1. 写在前面 之前我们跑了Angular的Hello World,你是不是对它有点感觉了呢?这一篇将结合一个TODO程序来继续学习Angular的用法 ...
- WinForm 控件不闪烁
1: [DllImport("user32")] 2: public static extern int SendMessage(IntPtr hwnd, int wMsg, in ...
- mysql常用操作命令
本章内容:(引用原文:http://www.cnblogs.com/suoning/p/5769141.html) 查看\创建\使用\删除 数据库 用户管理及授权实战 局域网远程连接法 查看\创建\使 ...
- HDU 1248 寒冰王座(全然背包:入门题)
HDU 1248 寒冰王座(全然背包:入门题) http://acm.hdu.edu.cn/showproblem.php?pid=1248 题意: 不死族的巫妖王发工资拉,死亡骑士拿到一张N元的钞票 ...
- Cts框架解析(8)-IBuildProvider
IBuildProvider接口中定义了三个方法 /* * Copyright (C) 2010 The Android Open Source Project * * Licensed under ...
- fopen 參数具体解释
fopen fopen(打开文件) 相关函数 open,fclose 表头文件 #include<stdio.h> 定义函数 FILE * fopen(const char * path, ...