历时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;