文档章节

ftp和http断点续传及下载的Delphi实现

vga
 vga
发布于 2017/04/05 15:34
字数 2462
阅读 29
收藏 0
ftp和http断点续传及下载的Delphi实现
2015-12-18 15:31 604人阅读 评论(0) 收藏 举报
 分类: Delphi(146)  
版权声明:本文为博主原创文章,未经博主允许不得转载。
(1)接下来我们来写最主要的代码,也就是下载部分了,首先来看HTTP协议的:
[delphi] view plain copy print?
procedure HttpDownLoad(const IdHTTP1:TIdHTTP;const aURL, aFile: string; const bResume: Boolean);  
var  
  tStream: TFileStream;  
begin //Http方式下载  
  if not CheckUrlFileExists(aURL) then  
  begin  
    MessageBox(0, '处理操作失败,服务器上文件不存在!', '系统提示', MB_OK  
      + MB_ICONSTOP + MB_TOPMOST);  
    Exit;  
  end;  
  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;  

这里我们同样使用IdHTTP的Get过程,函数的aURL是网址,aFile是保存的文件名,bResume确定是否续传,需要注意的就是续传方式时的代码:
[delphi] view plain copy print?
IdHTTP1.Request.ContentRangeStart := tStream.Size - 1;  
tStream.Position := tStream.Size - 1; //移动到最后继续下载  
IdHTTP1.Head(aURL);  
IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;  

第一行我们将下载开始位置设置为读入文件流的末尾,也就是设置为已经下载了的那部分文件的大小,第二行我们将文件流本身也指向自己的末尾,第三行我们通过Head过程得到网址头信息,在第四行将头信息的文件总大小赋值给下载的结束的位置,至于这里为什么第一行和第二行代码最后都要-1,我当时没有加-1的时候在续下载一个完整的已经下载的文件的时候总是提示错误,最后跟踪IdHTTP的代码发现他在处理下载范围的时候如果开始的位置和结束位置一样时会引发将浮点数转为整数的错误,因而这里加上-1防止这种错误发生,另外一种处理方法就是比较如果开始位置等于结束位置就退出也是可以的。
再来看看要用到的几个检测函数:
[delphi] view plain copy print?
function  CheckUrlFileExists(const aURL: string):Boolean;  
//uses WinInet;  
var  
  hSession, hfile: hInternet;  
  dwindex, dwcodelen: dword;  
  dwcode: array[1..20] of Char;  
  res: PChar;  
  url:string;  
begin  
  Result := false;  
  url := aURL;  
  if Pos('http://', LowerCase(url)) = 0 then  
    url := 'http://' + url;  
  hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG,  nil, nil, 0);  
  if Assigned(hsession) then  
  begin  
    hfile := InternetOpenUrl(hsession, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);  
    dwIndex := 0;  
    dwCodeLen := 10;  
    HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);  
    res := PChar(@dwcode);  
    Result := (res = '200') or (res = '302'); //200,302未重定位标志  
    if Assigned(hfile) then  
      InternetCloseHandle(hfile);  
    InternetCloseHandle(hsession);  
  end;  
end;  
  
function  CheckFtpFileExists(const IdFTP:TIdFTP;const fn:string):Boolean;  
var  
  listFTPFile:TStringList;  
begin  
  Result := False;  
  listFTPFile := TStringList.create;  
  try  
    try  
      IdFTP.List(listFTPFile, ExtractFileName(fn));  
    except  
    end;  
    if(listFTPFile.Count > 0) then  
    begin  
      Result := True;  
     //ShowMessage('文件:' + SFile + '不存在!');  
    end;  
  finally  
    FreeAndNil(listFTPFile );  
  end;  
end;  
  
function GetFileNameFromURL(const aURL: string): string;  
var ts : TStrings;  
begin  
  //从url取得文件名  
  ts := TStringList.create;  
  try  
    ts.Delimiter :='/';  
    ts.DelimitedText := aURL;  
    if ts.Count > 0 then  
      Result := ts[ts.Count - 1];  
  finally  
    ts.Free;  
  end;  
end;  
再来看FTP协议的下载过程:
[delphi] view plain copy print?
procedure FtpDownLoad(const IdFTP1:TIdFTP;const aURL, aFile: string; bResume: Boolean);  
var  
  tStream: TFileStream;  
  sName, sPass, sHost, sPort, sDir: string;  
  BytesToTransfer:Int64;  
begin //ftp方式下载  
  if not CheckFtpFileExists(IdFTP1,aURL) then  
  begin  
    MessageBox(0, '处理操作失败,服务器上文件不存在!', '系统提示', MB_OK  
      + MB_ICONSTOP + MB_TOPMOST);  
    Exit;  
  end;  
  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;  

这个过程中我们就用到了GetFTPParams()函数将网址的用户名、密码、主机地址、端口、路径等信息分离出来,IdFTP利用这些信息登陆服务器并到相应目录,最后利用Get()过程就很容易实现下载了,它的续传就比HTTP协议要简单很多,因为IdFTP的Get()本身就支持续传。
这里我简单穿插一点的内容,一个服务器是否支持断点续传,我们可以通过发送"REST 1"FTP指令来检测,如果返回350则表示支持。
最后我们根据网址来确定使用什么协议来下载:
[delphi] view plain copy print?
function GetProtocol(const 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;  
也可以使用TIdURI类,在IdURI.pas单元,这个类可以很轻松的将我们上面的GetProtocol()函数的功能实现,例如:
[delphi] view plain copy print?
function GetFTPParams(const aURL:string;out sProtocol, sName, sPass, sHost, sPort, sDir:string):Boolean;  
var  
  URI: TIdURI;  
begin  
  URI := TIdURI.Create(aURL); //建立  
  try  
    sProtocol := URI.Protocol; //协议  
    sHost := URI.Host; //主机  
    sName := URI.Username;  
    sPass := URI.Password;  
    sPort := URI.Port; //端口  
    if sPort='' then  
      sPort := '21';  
    sDir := URI.Path;  
    //sDir := URI.PathEncode(sDir);  
    //……等等都可以通过URI的属性得到  
  finally  
    URI.Free;  
  end;  
end;  

这个函数根据URL网址返回整数供我们使用,例如我们可以。
[delphi] view plain copy print?
procedure TMainForm.DownLoadFile(const aURL, aFile: string; const bResume: Boolean);  
begin  
  case GetProtocol(aURL) of  
    0: ShowMessage('不可识别的地址!');  
    1: HttpDownLoad(IdHTTP1, aURL, aFile, bResume);  
    2: FtpDownLoad(IdFTP1, aURL, aFile, bResume);  
  end;  
end;  

这个过程就利用GetProtocol()函数返回的整数执行相应的协议下载过程。
好么如何实现FTP协议的上传呢?
[delphi] view plain copy print?
procedure FtpUpLoad(const IdFTP1:TIdFTP;const aURL, aFile: string; const bResume: Boolean);  
var  
  //tStream: TFileStream;  
  sProtocol, sName, sPass, sHost, sPort, sDir: string;  
  BytesToTransfer:Int64;  
  dFile:string;  
begin //ftp方式上传  
  if not FileExists(aFile) then //源文件是否存在  
    Exit;  
  
  GetFTPParams(aURL,sProtocol,sName, sPass, sHost, sPort, sDir);  
  with IdFTP1 do  
  try  
    if Connected then Disconnect; //重新连接  
    Username := sName;  
    Password := sPass;  
    Host := sHost;  
    Port := StrToIntDef(sPort,21);  
    Connect;  
  except  
    Exit;  
  end;  
  IdFTP1.TransferType := ftASCII;  
  IdFTP1.ChangeDir(sDir); //改变目录  
  dFile := GetFileNameFromURL(aURL);  
    
  if CheckFtpFileExists(IdFTP1,dFile) then //服务器上的文件是否存在  
  begin  
    if MessageBox(0,  
      '服务器已存在同名文件,要继续上传并覆盖服务器上此文件吗?', '系统提示',  
      MB_YESNO + MB_ICONWARNING + MB_DEFBUTTON2 + MB_TOPMOST) = IDNO then  
    begin  
      Exit;  
    end;  
  end;  
  
  IdFTP1.TransferType := ftBinary;  
  try  
    try  
    if bResume then //续传  
    begin  
      IdFTP1.Put(aFile, dFile, True);  
    end else  
    begin  
      IdFTP1.Put(aFile, dFile, False);  
    end;  
    except  
      on e:Exception do  
      begin  
        if e.Message='' then  
          MessageBox(0,  
            '操作失败!请检查要上传的文件大小是否超过服务器的限制!',  
            '系统提示', MB_OK + MB_ICONSTOP + MB_TOPMOST)  
        else  
          MessageBox(0,  
            PChar('操作失败!'+e.Message),  
            '系统提示', MB_OK + MB_ICONSTOP + MB_TOPMOST);  
        IdFTP1.Delete(dFile);  
      end;  
    end;  
  finally  
    //tStream.Free;  
  end;  
end;  
(2) 接下来看看主窗口中每个按钮的代码,有了上面的函数,按钮的代码就简单多了:
下载按钮:
[delphi] view plain copy print?
procedure TMainForm.Button1Click(Sender: TObject);  
var  
  aURL, aFile: string;  
begin  
  aURL := ComboBox1.Text; //下载地址,例如"http://www.2ccc.com/update/demo.exe";  
  aFile := GetURLFileName(aURL); //得到文件名,例如"demo.exe"  
  if FileExists(aFile) then  
  begin  
    case MessageDlg('本地文件已经存在,是否续传?', mtConfirmation, mbYesNoCancel, 0) of  
      mrYes: DownLoadFile(aURL, aFile, True); //续传  
      mrNo: DownLoadFile(aURL, aFile, False); //覆盖  
      mrCancel: Exit; //取消  
    end;  
  end else DownLoadFile(aURL, aFile, False); //建立新文件下载  
end;  

MessageDlg()函数弹出一个对话框让用户选择续传、覆盖还是取消下载。
中断按钮:
[delphi] view plain copy print?
procedure TMainForm.Button2Click(Sender: TObject);  
begin  
  AbortTransfer := True;  
end;  

前面忘了介绍,所以这里大家看不明白,AbortTransfer是我们定义的一个私有变量,在开始下载的时候将它设为False,下载的过程中随时监测这个变量,一旦变为True就利用IdHTTP的Disconnect和IdFTP1的Abort方法中断下载,如果没有下载完就中断,那程序的目录中就会有一个下载不完整的程序或者其他东西,下次再下载的时候我们就可以选择续传来完成剩下的下载过程。
[delphi] view plain copy print?
procedure TMainForm.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;  
  const AWorkCountMax: Integer);  
begin  
  AbortTransfer := False;  
  //……  
end;  
在IdHTTP1和IdFTP的OnWorkBegin事件我们就将AbortTransfer设置为False了,在他们的Work事件中,我们检测AbortTransfer变量来完成是否中断的操作。
[delphi] view plain copy print?
procedure TMainForm.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;  
  const AWorkCount: Integer);  
begin  
  if AbortTransfer then  
  begin //中断下载  
    IdHTTP1.Disconnect;  
    IdFTP1.Abort;  
  end;  
  ProgressBar1.Position := AWorkCount;  
  Application.ProcessMessages;  
end;  

(3) 最后是连接状态等信息的代码:
在IdHTTP和IdFTP的OnStatus事件写入:
[delphi] view plain copy print?
procedure TMainForm.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;  
  const AStatusText: string);  
var  
  msg:string;  
begin  
  case AStatus of  
    hsResolving: msg := '正在解析数据……';  
    hsConnecting: msg := '正在连接服务器……';  
    hsConnected: msg := '服务器连接成功!';  
    hsDisconnecting: msg := '正在断开与服务器的连接……';  
    hsDisconnected: msg := '服务器连接已断开!';  
    hsStatusText: msg := '正在切换服务器状态……';  
    ftpTransfer: msg := '正在传输数据……';  // These are to eliminate the TIdFTPStatus and the  
    ftpReady: msg := '操作完成,数据传输OK!';//'服务器已准备OK!';     // coresponding event  
    ftpAborted: msg := '任务被中止!';  
  end;  
  ListBox1.ItemIndex := ListBox1.Items.Add(msg);  
end;  
在IdHTTP和IdFTP的OnWordEnd事件写入:
[delphi] view plain copy print?
procedure TMainForm.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);  
begin  
  if AWorkMode=wmWrite then  
  begin  
    if ASender is TIdFTP then  
      MessageBox(Handle, '操作结束,数据传输完成!', '系统提示', MB_OK +  
        MB_ICONINFORMATION + MB_TOPMOST);  
  end;  
end;  

因为IdHTTP和IdFTP在OnWork、OnStatus等事件上执行的代码都是一样的,所以我们只用写其中一个的代码,然后另外一个选择相同的事件就OK了。
(3)全部代码写完收工,F9运行一下看看效果,是不是能断点续传。

本程序主要的功能由IdHTTP和IdFTP组件完成,主要掌握他们的Get过程实现断点续传的方法以及字符串的分析分解方法,这里我们同样使用了流格式,不过这次不是内存流而是文件流。通过本例,读者应该初步掌握调试程序时断点的使用,事件代码的共用等。 使用此类我们的程序可以变得更简单,如何修改就留给读者自己去完善吧。

本文转载自:http://blog.csdn.net/xieyunc/article/details/50352081

共有 人打赏支持
vga

vga

粉丝 21
博文 363
码字总数 26355
作品 0
佳木斯
私信 提问
解读断点续传的基本原理

断点续传的理解可以分为两部分:一部分是断点,一部分是续传。断点的由来是在下载过程中,将一个下载文件分成了多个部分,同时进行多个部分一起 的下载,当某个时间点,任务被暂停了,此时下...

bengozhong
2016/08/31
21
0
Delphi用ICS控件进行断点续传

Delphi用ICS控件进行断点续传 原帖地址:http://www.lonetear.net/bbs/read.asp?id=36143 原帖地址2(傻猫):http://www.samool.com/archives/41252/ 用HTTPCLI和NMHTTP都可以实现断点续传,原理...

vga
2014/06/07
0
0
Linux下载命令Wget用法简介

wget是个强力方便的命令行方式下的下载工具。本文介绍了wget的基本用法。 网络用户有时候会碰到需要下载一批文档的情况,有时甚至需要把整个网站下载下来或制作网站的映像。在Windows下的用户...

任远
2010/11/01
0
0
物联网协议 HTTP libcurl

参考https://yq.aliyun.com/ask/300773 curl是利用URL语法在命令行方式下工作的开源文件传输工具。 它支持很多协议:DICT, FILE, FTP, FTPS, Gopher, HTTP, HTTPS, IMAP, IMAPS, LDAP, LDAP...

iotcsdn
2018/12/13
0
0
java实现FTP多线程断点续传,上传下载!

package com.ftp; import java.io.File; import java.io.FileOutputStream; import java.io.IOException; import java.io.InputStream; import java.io.OutputStream; import java.io.PrintW......

狼狼A狗
2011/03/22
0
3

没有更多内容

加载失败,请刷新页面

加载更多

Java 帝国对 Python 的渗透能成功吗?哈哈

引子 Java 帝国已经成立20多年,经过历代国王的励精图治,可以说是地大物博,码农众多。 可是国王依然不满足,整天想着如何继续开拓疆土, 这一天晚上他又把几个重臣招来商议了。 IO大臣说:...

边鹏_尛爺鑫
53分钟前
5
0
分布式事务解决方案框架(LCN)

什么是XA接口 XA是一个分布式事务协议,由Tuxedo提出。XA中大致分为两部分:事务管理器和本地资源管理器。其中本地资源管理器往往由数据库实现,比如Oracle、DB2这些商业数据库都实现了XA接口...

群星纪元
今天
6
0
linux 操作系统 常用命令和软件安装

1.系统时间更新 ntpdate time.windows.com 2.传送文件 rsync -av /home/data/a.dat -e ssh root@192.168.0.100:/home 3.传送文件夹 scp -r /home/data root@192.168.0.100:/home 4.JDK安装 ......

WJtiny
今天
2
0
pg_lightool基于basebackup的单表恢复和块恢复

开源软件pg_lightool,实现了基于wal日志的块恢复。详情参见博客:https://my.oschina.net/lcc1990/blog/1931485。由于wal日志中FPW的不确定性,它不能作为一个数据库恢复的解决方案。目前对...

movead
今天
2
0
对比剖析Swarm Kubernetes Marathon编排引擎

Docker Native Orchestration 基本结构 Docker Engine 1.12 集成了原生的编排引擎,用以替换了之前独立的Docker Swarm项目。Docker原生集群(Swarm)同时包括了(Docker Engine \/ Daemons)...

Linux就该这么学
今天
2
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部