Delphi完成的断点续传例子 转
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdFTP, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, IdHTTPHeaderInfo, ExtCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
ProgressBar1: TProgressBar;
Button2: TButton;
IdHTTP1: TIdHTTP;
IdFTP1: TIdFTP;
Button3: TButton;
ComboBox1: TComboBox;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
procedure Button3Click(Sender: TObject);
private
AbortTransfer: Boolean; //是否中断
BytesToTransfer: LongWord; //下载总大小
procedure FtpDownLoad(aURL, aFile: string; bResume: Boolean);
procedure HttpDownLoad(aURL, aFile: string; bResume: Boolean);
procedure MyDownLoad(aURL, aFile: string; bResume: Boolean);
function GetProt(aURL: string): Byte;
function GetURLFileName(aURL: string): string;
procedure GetFTPParams(aURL: string; var sName, sPass, sHost, sPort,
sDir: string);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
var
AverageSpeed: Double = ;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
end;
function TForm1.GetProt(aURL: string): Byte;
begin //检测下载的地址是http还是ftp
Result := ;
if Pos('http', LowerCase(aURL)) = then
Result := ; //http协议
if Pos('ftp', LowerCase(aURL)) = then
Result := ; //ftp协议
end;
function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin //返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> do //去掉"/"前面的内容剩下的就是文件名了
begin
Delete(s, , i);
i := Pos('/', s);
end;
Result := s;
end;
procedure TForm1.GetFTPParams(aURL: string; var sName, sPass, sHost, sPort, sDir: string);
var
i, j: integer;
s, tmp: string;
begin //分析ftp地址的登陆用户名,密码和目录
s := aURL;
if Pos('ftp://', LowerCase(s)) <> then //去掉ftp头
Delete(s, , );
i := Pos('@', s);
if i <> then //地址含用户名,也可能含密码
begin
tmp := Copy(s, , i - );
s := copy(s, i+, Length(s));
j := Pos(':', tmp);
if j <> then //包含密码
begin
sName := Copy(tmp, , j - ); //得到用户名
sPass := Copy(tmp, j + , i - j - ); //得到密码
end else
begin
sName := tmp;
sPass := Inputbox('输入框','请输入登陆ftp密码','');
end;
end else //匿名用户
begin
sName := 'anonymous';
sPass := 'test@ftp.com';
end;
i := Pos(':', s);
j := Pos('/', s);
sHost := Copy(s, , j - ); //主机
if i <> then //含端口
sPort := Copy(s, i + , j - i - ) else
sPort := ''; //默认21端口
tmp := Copy(s, j + , Length(s));
while j <> do
begin
Delete(s, , j);
j := Pos('/', s);
end; //目录
sDir := '/' + Copy(tmp, , Length(tmp) - Length(s) - );
end;
procedure TForm1.FtpDownLoad(aURL, aFile: string; bResume: Boolean);
var
tStream: TFileStream;
sName, sPass, sHost, sPort, sDir: string;
begin //ftp方式下载
if FileExists(aFile) then //建立文件流
tStream := TFileStream.Create(aFile, fmOpenWrite) else
tStream := TFileStream.Create(aFile, fmCreate);
GetFTPParams(aURL, sName, sPass, sHost, sPort, sDir);
with IdFTP1 do
try
if Connected then Disconnect; //重新连接
Username := sName;
Password := sPass;
Host := sHost;
Port := StrToInt(sPort);
Connect;
except
exit;
end;
IdFTP1.ChangeDir(sDir); //改变目录
BytesToTransfer := IdFTP1.Size(aFile);
try
if bResume then //续传
begin
tStream.Position := tStream.Size;
IdFTP1.Get(aFile, tStream, True);
end else
begin
IdFTP1.Get(aFile, tStream, False);
end;
finally
tStream.Free;
end;
end;
procedure TForm1.HttpDownLoad(aURL, aFile: string; bResume: Boolean);
var
tStream: TFileStream;
begin //Http方式下载
if FileExists(aFile) then //如果文件已经存在
tStream := TFileStream.Create(aFile, fmOpenWrite) else
tStream := TFileStream.Create(aFile, fmCreate);
if bResume then //续传方式
begin
IdHTTP1.Request.ContentRangeStart := tStream.Size - ;
tStream.Position := tStream.Size - ; //移动到最后继续下载
IdHTTP1.Head(aURL);
IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;
end else //覆盖或新建方式
begin
IdHTTP1.Request.ContentRangeStart := ;
end;
try
IdHTTP1.Get(aURL, tStream); //开始下载
finally
tStream.Free;
end;
end;
procedure TForm1.MyDownLoad(aURL, aFile: string; bResume: Boolean);
begin
case GetProt(aURL) of
: ShowMessage('不可识别的地址!');
: HttpDownLoad(aURL, aFile, bResume);
: FtpDownLoad(aURL, aFile, bResume);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
aURL, aFile: string;
begin
aURL := ComboBox1.Text; //下载地址,例如"http://www.baidu.com/update/test.exe"
aFile := GetURLFileName(aURL); //得到文件名,例如"test.exe"
if FileExists(aFile) then
begin
case MessageDlg('文件已经存在,是否续传?', mtConfirmation, mbYesNoCancel, ) of
mrYes: MyDownLoad(aURL, aFile, True); //续传
mrNo: MyDownLoad(aURL, aFile, False); //覆盖
mrCancel: Exit; //取消
end;
end else MyDownLoad(aURL, aFile, False); //建立新文件下载
end;
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin //中断下载
IdHTTP1.Disconnect;
IdFTP1.Abort;
end;
ProgressBar1.Position := AWorkCount;
Application.ProcessMessages;
end;
procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
AbortTransfer := False;
if AWorkCountMax > then
ProgressBar1.Max := AWorkCountMax else
ProgressBar1.Max := BytesToTransfer;
end;
procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position := ;
end;
procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Close;
end;
end.
http://www.codefans.net/articles/1342.shtml
Delphi完成的断点续传例子,在网络应用中,断点续传是相当实用的,比如自动升级、或下载程序中,都可以用到。在Delphi7中,可以使用TIdHTTP和TIdFTP组件实现基于HTTP协议的断点续传和FTP协议的断点续传,都是使用的Indy系列组件,使用方法大同小异,下面来看运行效果图:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdFTP, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, IdHTTPHeaderInfo, ExtCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
ProgressBar1: TProgressBar;
Button2: TButton;
IdHTTP1: TIdHTTP;
IdFTP1: TIdFTP;
Button3: TButton;
ComboBox1: TComboBox;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
procedure Button3Click(Sender: TObject);
private
AbortTransfer: Boolean; //是否中断
BytesToTransfer: LongWord; //下载总大小
procedure FtpDownLoad(aURL, aFile: string; bResume: Boolean);
procedure HttpDownLoad(aURL, aFile: string; bResume: Boolean);
procedure MyDownLoad(aURL, aFile: string; bResume: Boolean);
function GetProt(aURL: string): Byte;
function GetURLFileName(aURL: string): string;
procedure GetFTPParams(aURL: string; var sName, sPass, sHost, sPort,
sDir: string);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
var
AverageSpeed: Double = 0;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
end;
function TForm1.GetProt(aURL: string): Byte;
begin //检测下载的地址是http还是ftp
Result := 0;
if Pos('http', LowerCase(aURL)) = 1 then
Result := 1; //http协议
if Pos('ftp', LowerCase(aURL)) = 1 then
Result := 2; //ftp协议
end;
function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin //返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
begin
Delete(s, 1, i);
i := Pos('/', s);
end;
Result := s;
end;
procedure TForm1.GetFTPParams(aURL: string; var sName, sPass, sHost, sPort, sDir: string);
var
i, j: integer;
s, tmp: string;
begin //分析ftp地址的登陆用户名,密码和目录
s := aURL;
if Pos('ftp://', LowerCase(s)) <> 0 then //去掉ftp头
Delete(s, 1, 6);
i := Pos('@', s);
if i <> 0 then //地址含用户名,也可能含密码
begin
tmp := Copy(s, 1, i - 1);
s := copy(s, i+1, Length(s));
j := Pos(':', tmp);
if j <> 0 then //包含密码
begin
sName := Copy(tmp, 1, j - 1); //得到用户名
sPass := Copy(tmp, j + 1, i - j - 1); //得到密码
end else
begin
sName := tmp;
sPass := Inputbox('输入框','请输入登陆ftp密码','');
end;
end else //匿名用户
begin
sName := 'anonymous';
sPass := 'test@ftp.com';
end;
i := Pos(':', s);
j := Pos('/', s);
sHost := Copy(s, 1, j - 1); //主机
if i <> 0 then //含端口
sPort := Copy(s, i + 1, j - i - 1) else
sPort := '21'; //默认21端口
tmp := Copy(s, j + 1, Length(s));
while j <> 0 do
begin
Delete(s, 1, j);
j := Pos('/', s);
end; //目录
sDir := '/' + Copy(tmp, 1, Length(tmp) - Length(s) - 1);
end;
procedure TForm1.FtpDownLoad(aURL, aFile: string; bResume: Boolean);
var
tStream: TFileStream;
sName, sPass, sHost, sPort, sDir: string;
begin //ftp方式下载
if FileExists(aFile) then //建立文件流
tStream := TFileStream.Create(aFile, fmOpenWrite) else
tStream := TFileStream.Create(aFile, fmCreate);
GetFTPParams(aURL, sName, sPass, sHost, sPort, sDir);
with IdFTP1 do
try
if Connected then Disconnect; //重新连接
Username := sName;
Password := sPass;
Host := sHost;
Port := StrToInt(sPort);
Connect;
except
exit;
end;
IdFTP1.ChangeDir(sDir); //改变目录
BytesToTransfer := IdFTP1.Size(aFile);
try
if bResume then //续传
begin
tStream.Position := tStream.Size;
IdFTP1.Get(aFile, tStream, True);
end else
begin
IdFTP1.Get(aFile, tStream, False);
end;
finally
tStream.Free;
end;
end;
procedure TForm1.HttpDownLoad(aURL, aFile: string; bResume: Boolean);
var
tStream: TFileStream;
begin //Http方式下载
if FileExists(aFile) then //如果文件已经存在
tStream := TFileStream.Create(aFile, fmOpenWrite) else
tStream := TFileStream.Create(aFile, fmCreate);
if bResume then //续传方式
begin
IdHTTP1.Request.ContentRangeStart := tStream.Size - 1;
tStream.Position := tStream.Size - 1; //移动到最后继续下载
IdHTTP1.Head(aURL);
IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;
end else //覆盖或新建方式
begin
IdHTTP1.Request.ContentRangeStart := 0;
end;
try
IdHTTP1.Get(aURL, tStream); //开始下载
finally
tStream.Free;
end;
end;
procedure TForm1.MyDownLoad(aURL, aFile: string; bResume: Boolean);
begin
case GetProt(aURL) of
0: ShowMessage('不可识别的地址!');
1: HttpDownLoad(aURL, aFile, bResume);
2: FtpDownLoad(aURL, aFile, bResume);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
aURL, aFile: string;
begin
aURL := ComboBox1.Text; //下载地址,例如"http://www.baidu.com/update/test.exe"
aFile := GetURLFileName(aURL); //得到文件名,例如"test.exe"
if FileExists(aFile) then
begin
case MessageDlg('文件已经存在,是否续传?', mtConfirmation, mbYesNoCancel, 0) of
mrYes: MyDownLoad(aURL, aFile, True); //续传
mrNo: MyDownLoad(aURL, aFile, False); //覆盖
mrCancel: Exit; //取消
end;
end else MyDownLoad(aURL, aFile, False); //建立新文件下载
end;
procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin //中断下载
IdHTTP1.Disconnect;
IdFTP1.Abort;
end;
ProgressBar1.Position := AWorkCount;
Application.ProcessMessages;
end;
procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
AbortTransfer := False;
if AWorkCountMax > 0 then
ProgressBar1.Max := AWorkCountMax else
ProgressBar1.Max := BytesToTransfer;
end;
procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position := 0;
end;
procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Close;
end;
end.
Delphi完成的断点续传例子 转的更多相关文章
- delphi 三层架构简单例子(经测试成功)
delphi 三层架构简单例子(经测试成功) 转载 2013年12月19日 09:48:57 1100 所谓三层: (1) 客户端 (2) 服务器端 (3) 数据库 在数据访问时,使得客户端必须通过服 ...
- Delphi Dll 动态调用例子(3)-仔细看一下
http://blog.163.com/bxf_0011/blog/static/35420330200952075114318/ Delphi 动态链接库的动态和静态调用 为了让人能快速的理解 静态 ...
- 转:Delphi 回调函数及例子
http://anony3721.blog.163.com/blog/static/5119742010866050589/ { http://anony3721.blog.163.com/blog/ ...
- Delphi Dll 动态调用例子(2)
http://zhidao.baidu.com/question/157196792.html delphi动态调用DLL 写了个1.dll内容如下 library Project2; uses Sy ...
- Delphi Ini 操作简单例子
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialog ...
- TControlStyle.csParentBackground的作用(附Delphi里的所有例子,待续)
Only applicable when Themes are enabled in applications on Windows XP. Causes the parent to draw its ...
- delphi 学习笔记的例子
由于360改变了共享策略,导致之前的共享连接不能使用 重新共享了下. http://yunpan.cn/cgS2DBRT572jy (提取码:1eda)
- Delphi Dll 动态调用例子(1)
http://blog.sina.com.cn/s/blog_62c46c3701010q7h.html 一.编写dll library TestDllByD2007; uses SysUtils, ...
- Delphi 停靠技术的应用
一.基础知识介绍 1.VCL组件的基础知识 在TWinControl类中有一个DockSite属性(boolean),它的作用是是否允许别的控件停靠在它的上面:在TControl类中有一个DragKi ...
随机推荐
- 在Ubuntu上安装JDK、Ant、Jmeter和Jenkins
一.前期准备 1. 在win7下载VMware.Ubuntu(用迅雷下比较快) 2. 安装完VMware后新建虚拟机,选择iso: 3. 具体配置参考如下,至此Ubantu安装完成 二.在Ubuntu ...
- oracle 11g ORA-12541: TNS: 无监听程序 (DBD ERROR: OCIServerAttach)
From :http://www.cnblogs.com/wangyt223/archive/2012/12/11/2812931.html em无法浏览,同时监听起不来.同时他的监听服务还是正常的, ...
- [vijos P1035] 贪婪的送礼者
为何我要做此等弱智题,只因我太久不码代码,心有所虚… 明天的任务是,做些难题,累了就理房间,实在不行就睡觉,不要做别的事情w 目测自己做不到呢OAO program vijos_p1035; ..] ...
- MATLAB 图像分类 Image Category Classification Using Bag of Features
使用MATLAB实现图像的识别,这是MATLAB官网上面的例子,学习一下. http://cn.mathworks.com/help/vision/examples/image-category-cl ...
- Nginx反向代理关于端口的问题
Nginx反向代理关于端口的问题 http://www.cnblogs.com/likehua/p/4056625.html Nginx默认反向后的端口为80,因此存在被代理后的端口为80的问 ...
- 利用Jmeter进行Web测试
JMeter介绍 脚本录制 运行JMeter进行测试 JMeter主要组件介绍 参数化设置 动态数据关联 使用命令行运行JMeter脚本 利用XSLT分析JMeter结果文件 1:JMeter,一个1 ...
- <转>.php导出excel(多种方法)
基本上导出的文件分为两种:1:类Excel格式,这个其实不是传统意义上的Excel文件,只是因为Excel的兼容能力强,能够正确打开而已.修改这种文件后再保存,通常会提示你是否要转换成Excel文件. ...
- C语言实现双向循环链表
#include <stdio.h> #include <stdlib.h> #include <string.h> struct list_head { stru ...
- Python OpenCV —— bitwise
关于图像的位操作,目的是为了将一个logo覆盖到另一个图片上. # -*- coding: utf-8 -*- """ Created on Wed Sep 28 20: ...
- 跟大牛之间关于hibernate的一些探讨记录
hibernate的工作原理!! 1.读取配置文件 2.读取并解析映射信息,创建SessionFactory 3.打开Session 4.创建事务Transcation 5.持久化操作 6.提交事务 ...