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

最新推荐文章于 2022-05-30 15:48:31 发布
weixin_34025151
最新推荐文章于 2022-05-30 15:48:31 发布
阅读量94
点赞数
文章标签： python
原文链接：https://my.oschina.net/u/582827/blog/873444
版权
2019独角兽企业重金招聘Python工程师标准>>>
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过程实现断点续传的方法以及字符串的分析分解方法，这里我们同样使用了流格式，不过这次不是内存流而是文件流。通过本例，读者应该初步掌握调试程序时断点的使用，事件代码的共用等。 使用此类我们的程序可以变得更简单，如何修改就留给读者自己去完善吧。
转载于:https://my.oschina.net/u/582827/blog/873444