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 ...
随机推荐
- iOS开发网络篇—搭建本地服务器
iOS开发网络篇—搭建本地服务器 一.简单说明 说明:提前下载好相关软件,且安装目录最好安装在全英文路径下.如果路径有中文名,那么可能会出现一些莫名其妙的问题. 提示:提前准备好的软件 apache- ...
- Huawei校招机试中的猴子吃桃问题
//============================================================================ // Name : Monkey& ...
- java web图片上传和文件上传
图片上传和文件上传本质上是一样的,图片本身也是文件.文件上传就是将图片上传到服务器,方式虽然有很多,但底层的实现都是文件的读写操作. 注意事项 1.form表单一定要写属性enctype=" ...
- Java类的成员函数调用顺序
class A { public A() { System.out.println("----------A 构造-------------"); } static void sb ...
- python 语法常用 lambda
Python中lambda表达式学习 http://blog.csdn.net/imzoer/article/details/8667176
- android 面试总结，后续注意学习
1.数据结构和算法 一般情况下,工作中是用不到的,但是就是问,每个公司都问,而且有的公司还问的特别深,还让你手写代码.我觉得这个确实有点恶心,我个人也是很讨厌算法的,但是真是没办法,人家就问,你说怎么 ...
- Python控制语句
1.结构化程序设计 结构化程序设计包含三种基本结构:顺序结构.选择结构.循环结构. 1)顺序结构 如图所示,虚线框内是一个顺序结构:其中A和B两个框是顺序执行的,即在执行完A框所指定的操作后,必然接着 ...
- C语言之const和define
const修饰的是只读变量,不是常量,其值在编译时不能被使用,因为编译器在编译时不知道其存储的内容.编译器通常不为普通const只读变量分配存储空间,而使将他们保存在符号表中,这使得他成为一个编译期间 ...
- POJ 1236 SCC+缩点
题意:一张有向图,一问至少给几个点发送软件,才能让所有点都能收到软件:二问是至少添加几条边才能让整个图是一个连通分量: 分析:一般求连通分量都会求缩点,在这里缩点之后,生成一张新的图,在新的图中求每一 ...
- springmvc学习笔记--支持文件上传和阿里云OSS API简介
前言: Web开发中图片上传的功能很常见, 本篇博客来讲述下springmvc如何实现图片上传的功能. 主要讲述依赖包引入, 配置项, 本地存储和云存储方案(阿里云的OSS服务). 铺垫: 文件上传是 ...