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

最新推荐文章于 2023-08-12 09:45:58 发布

小宇飞刀

最新推荐文章于 2023-08-12 09:45:58 发布

阅读量5.7k

点赞数

分类专栏： Delphi

本文链接：https://blog.csdn.net/xieyunc/article/details/50352081

版权

Delphi 专栏收录该内容

160 篇文章 6 订阅

订阅专栏

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

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确定是否续传，需要注意的就是续传方式时的代码：

    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防止这种错误发生，另外一种处理方法就是比较如果开始位置等于结束位置就退出也是可以的。

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

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协议的下载过程：

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则表示支持。

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

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()函数的功能实现，例如：

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网址返回整数供我们使用，例如我们可以。

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协议的上传呢？

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）接下来看看主窗口中每个按钮的代码，有了上面的函数，按钮的代码就简单多了：

下载按钮：

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()函数弹出一个对话框让用户选择续传、覆盖还是取消下载。
中断按钮：

procedure TMainForm.Button2Click(Sender: TObject);
begin
  AbortTransfer := True;
end;

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

procedure TMainForm.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  AbortTransfer := False;
  //……
end;

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

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事件写入：

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事件写入：

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，可以参考一下。