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

（1）接下来我们来写最主要的代码，也就是下载部分了，首先来看HTTP协议的：

[delphi] view plain copy

 print?

1. procedure HttpDownLoad(const IdHTTP1:TIdHTTP;const aURL, aFile: string; const bResume: Boolean);  
2. var  
3.   tStream: TFileStream;  
4. begin //Http方式下载  
5.   if not CheckUrlFileExists(aURL) then  
6.   begin  
7.     MessageBox(0, '处理操作失败，服务器上文件不存在！', '系统提示', MB_OK  
8.       + MB_ICONSTOP + MB_TOPMOST);  
9.     Exit;  
10.   end;  
11.   if FileExists(aFile) then //如果文件已经存在  
12.     tStream := TFileStream.Create(aFile, fmOpenWrite) else  
13.     tStream := TFileStream.Create(aFile, fmCreate);  
14.   
15.   if bResume then //续传方式  
16.   begin  
17.     IdHTTP1.Request.ContentRangeStart := tStream.Size - 1;  
18.     tStream.Position := tStream.Size - 1; //移动到最后继续下载  
19.     IdHTTP1.Head(aURL);  
20.     IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;  
21.   end else //覆盖或新建方式  
22.   begin  
23.     IdHTTP1.Request.ContentRangeStart := 0;  
24.   end;  
25.   
26.   try  
27.     IdHTTP1.Get(aURL, tStream); //开始下载  
28.   finally  
29.     tStream.Free;  
30.   end;  
31. end;  

这里我们同样使用IdHTTP的Get过程，函数的aURL是网址，aFile是保存的文件名，bResume确定是否续传，需要注意的就是续传方式时的代码：

[delphi] view plain copy

 print?

1. IdHTTP1.Request.ContentRangeStart := tStream.Size - 1;  
2. tStream.Position := tStream.Size - 1; //移动到最后继续下载  
3. IdHTTP1.Head(aURL);  
4. IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;  

第一行我们将下载开始位置设置为读入文件流的末尾，也就是设置为已经下载了的那部分文件的大小，第二行我们将文件流本身也指向自己的末尾，第三行我们通过Head过程得到网址头信息，在第四行将头信息的文件总大小赋值给下载的结束的位置，至于这里为什么第一行和第二行代码最后都要-1，我当时没有加-1的时候在续下载一个完整的已经下载的文件的时候总是提示错误，最后跟踪IdHTTP的代码发现他在处理下载范围的时候如果开始的位置和结束位置一样时会引发将浮点数转为整数的错误，因而这里加上-1防止这种错误发生，另外一种处理方法就是比较如果开始位置等于结束位置就退出也是可以的。

再来看看要用到的几个检测函数：

[delphi] view plain copy

 print?

1. function  CheckUrlFileExists(const aURL: string):Boolean;  
2. //uses WinInet;  
3. var  
4.   hSession, hfile: hInternet;  
5.   dwindex, dwcodelen: dword;  
6.   dwcode: array[1..20] of Char;  
7.   res: PChar;  
8.   url:string;  
9. begin  
10.   Result := false;  
11.   url := aURL;  
12.   if Pos('http://', LowerCase(url)) = 0 then  
13.     url := 'http://' + url;  
14.   hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG,  nil, nil, 0);  
15.   if Assigned(hsession) then  
16.   begin  
17.     hfile := InternetOpenUrl(hsession, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);  
18.     dwIndex := 0;  
19.     dwCodeLen := 10;  
20.     HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);  
21.     res := PChar(@dwcode);  
22.     Result := (res = '200') or (res = '302'); //200,302未重定位标志  
23.     if Assigned(hfile) then  
24.       InternetCloseHandle(hfile);  
25.     InternetCloseHandle(hsession);  
26.   end;  
27. end;  
28.   
29. function  CheckFtpFileExists(const IdFTP:TIdFTP;const fn:string):Boolean;  
30. var  
31.   listFTPFile:TStringList;  
32. begin  
33.   Result := False;  
34.   listFTPFile := TStringList.create;  
35.   try  
36.     try  
37.       IdFTP.List(listFTPFile, ExtractFileName(fn));  
38.     except  
39.     end;  
40.     if(listFTPFile.Count > 0) then  
41.     begin  
42.       Result := True;  
43.      //ShowMessage（'文件：' + SFile + '不存在!');  
44.     end;  
45.   finally  
46.     FreeAndNil(listFTPFile );  
47.   end;  
48. end;  
49.   
50. function GetFileNameFromURL(const aURL: string): string;  
51. var ts : TStrings;  
52. begin  
53.   //从url取得文件名  
54.   ts := TStringList.create;  
55.   try  
56.     ts.Delimiter :='/';  
57.     ts.DelimitedText := aURL;  
58.     if ts.Count > 0 then  
59.       Result := ts[ts.Count - 1];  
60.   finally  
61.     ts.Free;  
62.   end;  
63. end;  

再来看FTP协议的下载过程：

[delphi] view plain copy

 print?

1. procedure FtpDownLoad(const IdFTP1:TIdFTP;const aURL, aFile: string; bResume: Boolean);  
2. var  
3.   tStream: TFileStream;  
4.   sName, sPass, sHost, sPort, sDir: string;  
5.   BytesToTransfer:Int64;  
6. begin //ftp方式下载  
7.   if not CheckFtpFileExists(IdFTP1,aURL) then  
8.   begin  
9.     MessageBox(0, '处理操作失败，服务器上文件不存在！', '系统提示', MB_OK  
10.       + MB_ICONSTOP + MB_TOPMOST);  
11.     Exit;  
12.   end;  
13.   if FileExists(aFile) then //建立文件流  
14.     tStream := TFileStream.Create(aFile, fmOpenWrite) else  
15.     tStream := TFileStream.Create(aFile, fmCreate);  
16.   
17.   GetFTPParams(aURL, sName, sPass, sHost, sPort, sDir);  
18.   with IdFTP1 do  
19.   try  
20.     if Connected then Disconnect; //重新连接  
21.     Username := sName;  
22.     Password := sPass;  
23.     Host := sHost;  
24.     Port := StrToInt(sPort);  
25.     Connect;  
26.   except  
27.     exit;  
28.   end;  
29.   
30.   IdFTP1.ChangeDir(sDir); //改变目录  
31.   BytesToTransfer := IdFTP1.Size(aFile);  
32.   try  
33.     if bResume then //续传  
34.     begin  
35.       tStream.Position := tStream.Size;  
36.       IdFTP1.Get(aFile, tStream, True);  
37.     end else  
38.     begin  
39.       IdFTP1.Get(aFile, tStream, False);  
40.     end;  
41.   finally  
42.     tStream.Free;  
43.   end;  
44. end;  

这个过程中我们就用到了GetFTPParams()函数将网址的用户名、密码、主机地址、端口、路径等信息分离出来，IdFTP利用这些信息登陆服务器并到相应目录，最后利用Get()过程就很容易实现下载了，它的续传就比HTTP协议要简单很多，因为IdFTP的Get()本身就支持续传。

这里我简单穿插一点的内容，一个服务器是否支持断点续传，我们可以通过发送"REST 1"FTP指令来检测，如果返回350则表示支持。

最后我们根据网址来确定使用什么协议来下载：

[delphi] view plain copy

 print?

1. function GetProtocol(const aURL: string): Byte;  
2. begin //检测下载的地址是http还是ftp  
3.   Result := 0;  
4.   if Pos('http', LowerCase(aURL)) = 1 then  
5.     Result := 1; //http协议  
6.   if Pos('ftp', LowerCase(aURL)) = 1 then  
7.     Result := 2; //ftp协议  
8. end;  

也可以使用TIdURI类，在IdURI.pas单元，这个类可以很轻松的将我们上面的GetProtocol()函数的功能实现，例如：

[delphi] view plain copy

 print?

1. function GetFTPParams(const aURL:string;out sProtocol, sName, sPass, sHost, sPort, sDir:string):Boolean;  
2. var  
3.   URI: TIdURI;  
4. begin  
5.   URI := TIdURI.Create(aURL); //建立  
6.   try  
7.     sProtocol := URI.Protocol; //协议  
8.     sHost := URI.Host; //主机  
9.     sName := URI.Username;  
10.     sPass := URI.Password;  
11.     sPort := URI.Port; //端口  
12.     if sPort='' then  
13.       sPort := '21';  
14.     sDir := URI.Path;  
15.     //sDir := URI.PathEncode(sDir);  
16.     //……等等都可以通过URI的属性得到  
17.   finally  
18.     URI.Free;  
19.   end;  
20. end;  

这个函数根据URL网址返回整数供我们使用，例如我们可以。

[delphi] view plain copy

 print?

1. procedure TMainForm.DownLoadFile(const aURL, aFile: string; const bResume: Boolean);  
2. begin  
3.   case GetProtocol(aURL) of  
4.     0: ShowMessage('不可识别的地址！');  
5.     1: HttpDownLoad(IdHTTP1, aURL, aFile, bResume);  
6.     2: FtpDownLoad(IdFTP1, aURL, aFile, bResume);  
7.   end;  
8. end;  

这个过程就利用GetProtocol()函数返回的整数执行相应的协议下载过程。

好么如何实现FTP协议的上传呢？

[delphi] view plain copy

 print?

1. procedure FtpUpLoad(const IdFTP1:TIdFTP;const aURL, aFile: string; const bResume: Boolean);  
2. var  
3.   //tStream: TFileStream;  
4.   sProtocol, sName, sPass, sHost, sPort, sDir: string;  
5.   BytesToTransfer:Int64;  
6.   dFile:string;  
7. begin //ftp方式上传  
8.   if not FileExists(aFile) then //源文件是否存在  
9.     Exit;  
10.   
11.   GetFTPParams(aURL,sProtocol,sName, sPass, sHost, sPort, sDir);  
12.   with IdFTP1 do  
13.   try  
14.     if Connected then Disconnect; //重新连接  
15.     Username := sName;  
16.     Password := sPass;  
17.     Host := sHost;  
18.     Port := StrToIntDef(sPort,21);  
19.     Connect;  
20.   except  
21.     Exit;  
22.   end;  
23.   IdFTP1.TransferType := ftASCII;  
24.   IdFTP1.ChangeDir(sDir); //改变目录  
25.   dFile := GetFileNameFromURL(aURL);  
26.     
27.   if CheckFtpFileExists(IdFTP1,dFile) then //服务器上的文件是否存在  
28.   begin  
29.     if MessageBox(0,  
30.       '服务器已存在同名文件，要继续上传并覆盖服务器上此文件吗？', '系统提示',  
31.       MB_YESNO + MB_ICONWARNING + MB_DEFBUTTON2 + MB_TOPMOST) = IDNO then  
32.     begin  
33.       Exit;  
34.     end;  
35.   end;  
36.   
37.   IdFTP1.TransferType := ftBinary;  
38.   try  
39.     try  
40.     if bResume then //续传  
41.     begin  
42.       IdFTP1.Put(aFile, dFile, True);  
43.     end else  
44.     begin  
45.       IdFTP1.Put(aFile, dFile, False);  
46.     end;  
47.     except  
48.       on e:Exception do  
49.       begin  
50.         if e.Message='' then  
51.           MessageBox(0,  
52.             '操作失败！请检查要上传的文件大小是否超过服务器的限制！',  
53.             '系统提示', MB_OK + MB_ICONSTOP + MB_TOPMOST)  
54.         else  
55.           MessageBox(0,  
56.             PChar('操作失败！'+e.Message),  
57.             '系统提示', MB_OK + MB_ICONSTOP + MB_TOPMOST);  
58.         IdFTP1.Delete(dFile);  
59.       end;  
60.     end;  
61.   finally  
62.     //tStream.Free;  
63.   end;  
64. end;  

（2） 接下来看看主窗口中每个按钮的代码，有了上面的函数，按钮的代码就简单多了：

下载按钮：

[delphi] view plain copy

 print?

1. procedure TMainForm.Button1Click(Sender: TObject);  
2. var  
3.   aURL, aFile: string;  
4. begin  
5.   aURL := ComboBox1.Text; //下载地址，例如"http://www.2ccc.com/update/demo.exe";  
6.   aFile := GetURLFileName(aURL); //得到文件名，例如"demo.exe"  
7.   if FileExists(aFile) then  
8.   begin  
9.     case MessageDlg('本地文件已经存在，是否续传？', mtConfirmation, mbYesNoCancel, 0) of  
10.       mrYes: DownLoadFile(aURL, aFile, True); //续传  
11.       mrNo: DownLoadFile(aURL, aFile, False); //覆盖  
12.       mrCancel: Exit; //取消  
13.     end;  
14.   end else DownLoadFile(aURL, aFile, False); //建立新文件下载  
15. end;  

MessageDlg()函数弹出一个对话框让用户选择续传、覆盖还是取消下载。
中断按钮：

[delphi] view plain copy

 print?

1. procedure TMainForm.Button2Click(Sender: TObject);  
2. begin  
3.   AbortTransfer := True;  
4. end;  

前面忘了介绍，所以这里大家看不明白，AbortTransfer是我们定义的一个私有变量，在开始下载的时候将它设为False，下载的过程中随时监测这个变量，一旦变为True就利用IdHTTP的Disconnect和IdFTP1的Abort方法中断下载，如果没有下载完就中断，那程序的目录中就会有一个下载不完整的程序或者其他东西，下次再下载的时候我们就可以选择续传来完成剩下的下载过程。

[delphi] view plain copy

 print?

1. procedure TMainForm.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;  
2.   const AWorkCountMax: Integer);  
3. begin  
4.   AbortTransfer := False;  
5.   //……  
6. end;  

在IdHTTP1和IdFTP的OnWorkBegin事件我们就将AbortTransfer设置为False了，在他们的Work事件中，我们检测AbortTransfer变量来完成是否中断的操作。

[delphi] view plain copy

 print?

1. procedure TMainForm.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;  
2.   const AWorkCount: Integer);  
3. begin  
4.   if AbortTransfer then  
5.   begin //中断下载  
6.     IdHTTP1.Disconnect;  
7.     IdFTP1.Abort;  
8.   end;  
9.   ProgressBar1.Position := AWorkCount;  
10.   Application.ProcessMessages;  
11. end;  

（3） 最后是连接状态等信息的代码：
在IdHTTP和IdFTP的OnStatus事件写入：

[delphi] view plain copy

 print?

1. procedure TMainForm.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;  
2.   const AStatusText: string);  
3. var  
4.   msg:string;  
5. begin  
6.   case AStatus of  
7.     hsResolving: msg := '正在解析数据……';  
8.     hsConnecting: msg := '正在连接服务器……';  
9.     hsConnected: msg := '服务器连接成功！';  
10.     hsDisconnecting: msg := '正在断开与服务器的连接……';  
11.     hsDisconnected: msg := '服务器连接已断开！';  
12.     hsStatusText: msg := '正在切换服务器状态……';  
13.     ftpTransfer: msg := '正在传输数据……';  // These are to eliminate the TIdFTPStatus and the  
14.     ftpReady: msg := '操作完成，数据传输OK！';//'服务器已准备OK！';     // coresponding event  
15.     ftpAborted: msg := '任务被中止！';  
16.   end;  
17.   ListBox1.ItemIndex := ListBox1.Items.Add(msg);  
18. end;  

在IdHTTP和IdFTP的OnWordEnd事件写入：

[delphi] view plain copy

 print?

1. procedure TMainForm.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);  
2. begin  
3.   if AWorkMode=wmWrite then  
4.   begin  
5.     if ASender is TIdFTP then  
6.       MessageBox(Handle, '操作结束，数据传输完成！', '系统提示', MB_OK +  
7.         MB_ICONINFORMATION + MB_TOPMOST);  
8.   end;  
9. end;  

因为IdHTTP和IdFTP在OnWork、OnStatus等事件上执行的代码都是一样的，所以我们只用写其中一个的代码，然后另外一个选择相同的事件就OK了。

（3）全部代码写完收工，F9运行一下看看效果，是不是能断点续传。

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

（4）做了一个简单的DEMO，可以参考一下。