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

转载自小宇飞刀http://blog.****.net/xieyunc

这个过程就利用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，可以参考一下。