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


(1)接下来我们来写最主要的代码,也就是下载部分了,首先来看HTTP协议的:
[delphi]
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]
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]
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]
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]
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]
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]
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]
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]
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]
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过程实现断点续传的方法以及字符串的分析分解方法,这里我们同样使用了流格式,不过这次不是内存流而是文件流。通过本例,读者应该初步掌握调试程序时断点的使用,事件代码的共用等。 使用此类我们的程序可以变得更简单,如何修改就留给读者自己去完善吧。

(4)做了一个简单的DEMO,可以参考一下。

来源:http://blog.csdn.net/xieyunc/article/details/50352081


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678