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

（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 
1e6c0
3; 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过程实现断点续传的方法以及字符串的分析分解方法，这里我们同样使用了流格式，不过这次不是内存流而是文件流。通过本例，读者应该初步掌握调试程序时断点的使用，事件代码的共用等。 使用此类我们的程序可以变得更简单，如何修改就留给读者自己去完善吧。

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