Delphi XE2 使用IdHttp下载文件(Get方法),支持断点续传

历时2天封装并自测了本页中的线程类。使用IdHttp实现文件下载,支持暂停下载、断点续传,使得文件下载更快;与UI的交互使用消息传递机制实现。源码已经在项目中使用,现将源码成果公布出来,供需要的人参考。

线程处理的逻辑大致如下:

1、先判断本地是否存在文件,如果没有,使用文件名+.tmp作为下载过程中的文件名;下载完成后更名为原始文件名;

2、如果存在文件名+.tmp,载入内存后继续下载(断点续传);

3、如果已经存在文件,判断文件大小是否与服务器一致,不一致则删除重新按照1的逻辑下载。

需要注意的有几点:

1、下载的文件地址是否需要做重定向转化

2、获取服务器中Url文件大小,使用Head方法可正常获取

3、本例中的代码无法下载Https协议中的文件,博文中另外一篇文章将有说明

4、重点:如果断点续传一直有问题,说明服务器不支持断点续传功能,本文代码就会有误。

先看看线程类:

{***********************************************************}
{ 单元功能说明:                                            }
{   文件下载单元,支持断点续传                              }
{   进度条在主窗体中,通过Message消息传递,可不设置         }
{                                                           }
{ 作者: Yothan(China)                                       }
{                                                           }
{ 备注:                                                     }
{ Copyright (c) 2013-2014 云露工作室.                     }
{***********************************************************}
unit uDownLoadFilesThread;

interface

uses
  System.Classes, IdHTTP, Winapi.Windows, System.SysUtils, IdComponent, Winapi.Messages;

const
  WM_DOWNLOADFILE=WM_USER + 202;
type
  TDownLoadFileThread = class(TThread)
  private
    { Private declarations }
    IdHttp: TIdHTTP;
    FParentHandle: THandle;//父窗体的句柄,用来发送消息
    FRefreshProgress: Boolean;
    FUrl,FSaveFilePath: string;
    BytesToTransfer: LongWord;
    FPausedDown: Boolean;
    FOpenFile: Boolean; //下载总大小
    function GetURLFileName(aURL: string): string;
    procedure IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
    procedure IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
    procedure IdHTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure HttpDownLoad(aURL, aFile: string; bResume: Boolean);
  protected
    procedure Execute; override;
  public
    /// <summary>
    /// <param name="AUrl">要下载的文件</param>
    /// <param name="ASaveFilePath">要保存的文件路径(绝对路径)</param>
    /// <param name="AParentHandle">生产者窗体句柄,用来更新窗体,可传0</param>
    /// <param name="ARefreshProgress">是否要更新进度条等UI</param>
    /// <param name="AParentHandle">线程是否挂起</param>
    /// </summary>
    constructor Create(AUrl,ASaveFilePath: string;AParentHandle: THandle; ARefreshProgress: Boolean; CreateSuspended: Boolean=False);
    destructor Destroy; override;
    /// <summary>
    /// 暂停下载
    /// </summary>
    property PausedDown: Boolean read FPausedDown write FPausedDown;
    /// <summary>
    /// 是否打开已下载的文件
    /// </summary>
    property OpenFile: Boolean read FOpenFile Write FOpenFile;
  end;

implementation
  uses Winapi.ActiveX, System.Win.ComObj;

{ TDownLoadFileThread }

constructor TDownLoadFileThread.Create(AUrl,ASaveFilePath: string; AParentHandle: THandle;
  ARefreshProgress, CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  IdHTTP := TIdHTTP.Create(nil);
  FUrl := AUrl;
  FSaveFilePath := ASaveFilePath;
  FParentHandle := AParentHandle;
  FRefreshProgress := ARefreshProgress;
  FreeOnTerminate := True;
  IdHTTP.OnWork := IdHTTPWork;
  IdHTTP.OnWorkBegin := IdHTTPWorkBegin;
  IdHTTP.OnWorkEnd := IdHTTPWorkEnd;
  IdHTTP.ConnectTimeout := 5000;
  IdHTTP.ReadTimeout := 10000
end;

destructor TDownLoadFileThread.Destroy;
begin
  IdHTTP.Disconnect;
  FreeAndNil(IdHTTP);
  inherited;
end;

procedure TDownLoadFileThread.Execute;
var
  aFile: string;
begin
  { Place thread code here }
  aFile := GetURLFileName(FURL); //得到文件名,例如"test.exe"
  if not DirectoryExists(FSaveFilePath) then
    ForceDirectories(FSaveFilePath);
  if FileExists(FSaveFilePath + aFile) then
    HttpDownLoad(FUrl, FSaveFilePath + aFile, True)
  else
    HttpDownLoad(FUrl, FSaveFilePath + aFile, False);
end;

function TDownLoadFileThread.GetURLFileName(aURL: string): string;
var
  i: integer;
  s: string;
begin //返回下载地址的文件名
  s := aURL;
  i := Pos('/', s);
  while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
  begin
    Delete(s, 1, i);
    i := Pos('/', s);
  end;
  Result := s;
end;

procedure TDownLoadFileThread.HttpDownLoad(aURL, aFile: string;
  bResume: Boolean);
var
  tStream: TFileStream;
  newUrl: string;
  wholeSize, fileSize, needDown: Int64;
begin //Http方式下载
  newUrl := IdHTTP.URL.URLEncode(aUrl);
  try
    IdHttp.HandleRedirects := True;//重定向
    IdHttp.Request.Range := '';
    IdHttp.Head(newUrl);
    wholeSize := IdHttp.Response.ContentLength;//获取文件大小
    if wholeSize <= 0 then
      Exit;
    if FileExists(aFile) then //如果文件已经存在
    begin
      tStream := TFileStream.Create(aFile, fmOpenWrite);
      try
        fileSize := tStream.Size;
        //大小不一致,表示文件损坏或有更新,删除重新下载
        if wholeSize <> fileSize then
        begin
          FreeAndNil(tStream);
          DeleteFile(aFile);
        end
        else
        begin
          //本地已经有相同的文件,直接发送下载完成消息
          if FOpenFile then
          begin
            FreeAndNil(tStream);
            //发送消息前,记得先Free掉Stream,否则会因为占用导致报错:Invalid operation point
            SendMessage(FParentHandle, WM_DOWNLOADFILE, 99, Integer(aFile));
          end;
          Exit;
        end;
      finally
        if Assigned(tStream) then
          FreeAndNil(tStream);
      end;
    end;
    try
      if FileExists(aFile+'.tmp') then
      begin
        tStream:=TFileStream.Create(aFile+'.tmp',fmOpenWrite);
        if tStream.Size>wholeSize then
        begin
          FreeAndNil(tStream);
          DeleteFile(aFile+'.tmp');
        end
        else if tStream.Size = wholeSize then
        begin
          //正好字节相同,表示已经下载完成,修改文件名称
          FreeAndNil(tStream);
          RenameFile(afile + '.tmp', aFile);
          if FOpenFile then
            SendMessage(FParentHandle, WM_DOWNLOADFILE, 99, Integer(aFile));
          Exit;
        end;
      end
      else
        tStream:=TFileStream.Create(aFile+'.tmp',fmCreate);
      tStream.Seek(0, soEnd);
      fileSize := tStream.Size;
      needDown := wholeSize - filesize;

      if needDown > 0 then
      begin
        if fileSize > 0 then
          IdHTTP.Request.Range := IntToStr(fileSize)+'-' +IntToStr(wholeSize);//注意:有的下载服务器不支持这种写法,会导致断点续传有误
        IdHTTP.Get(newUrl, tStream);
        //如果文件大小相同,表示下载完毕
        //否则可能是暂停导致的结束
        if tStream.Size = wholeSize then
        begin
          FreeAndNil(tStream);
          RenameFile(afile + '.tmp', aFile);
          if FOpenFile then
            SendMessage(FParentHandle, WM_DOWNLOADFILE, 99, Integer(aFile));
        end;
      end;
    finally
      if Assigned(tStream) then
        FreeAndNil(tStream);
    end;
  except on e:Exception do
  begin
    //下载失败
    SendMessage(FParentHandle, WM_DOWNLOADFILE, -1, 0);
//    log4Debug('文件下载失败:(' + aFile+')'+ e.Message);
  end;
  end;

end;

procedure TDownLoadFileThread.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  if PausedDown then
  begin //中断下载
    IdHTTP.Disconnect;
  end;
  if FRefreshProgress then
    SendMessage(FParentHandle, WM_DOWNLOADFILE, 2, AWorkCount);//发送消息,通知下载进度
end;

procedure TDownLoadFileThread.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
var
  iMax: Integer;
begin
  PausedDown := False;
  if not FRefreshProgress then Exit;
  if AWorkCountMax > 0 then
    iMax := AWorkCountMax
  else
    iMax := BytesToTransfer;
  SendMessage(FParentHandle, WM_DOWNLOADFILE, 1, iMax);//发生消息,通知主窗体开始下载
end;

procedure TDownLoadFileThread.IdHTTPWorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin

end;

end.

主窗体中调用线程的部分:

aThread: TDownLoadFileThread;
  aThread := TDownLoadFileThread.Create(RzEditUrl.Text, ExtractFilePath(ParamStr(0))+'Down\', self.Handle, True, True);
  aThread.OnTerminate := ThreadFinish;
  aThread.OpenFile := True;
  aThread.Resume;

消息的定义和实现:

procedure WMMemberMessage(var msg: TMessage); Message WM_DOWNLOADFILE;
//具体的实现逻辑
procedure TForm11.WMMemberMessage(var msg: TMessage);
var s:string;
begin
  if msg.WParam = 1 then
  begin
    ProgressBar1.Properties.Max := msg.LParam;
    ProgressBar1.Visible := True;
  end
  else if msg.WParam = 2 then
    ProgressBar1.Position := msg.LParam
  else if msg.WParam = 3 then
    ProgressBar1.Position := ProgressBar1.Properties.Max
  else if msg.WParam = 99 then
  begin
    s :=  String(Msg.LParam);
    ShellExecute(0, 'open', PWideChar(s), nil,nil, SW_SHOWNORMAL);
  end
  else if msg.WParam = -1 then
    ShowMessage('下载失败,请稍后重试。')
  else
    inherited;
end;


已标记关键词 清除标记
相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页