unit IndyDownLoadFile;
interface
uses
Windows, SysUtils, Classes, IdComponent, IdHTTP;
type
TSubThReturnDataEvent = procedure(StartPos, WorkCount: Integer; Data: Pointer; var Stop: Boolean) of object;
TReturnDataEvent = procedure(StartPos, WorkCount: Integer; Data: Pointer) of object;
TBufReadEvent = procedure(Buf: PChar; BufLen: Integer; Data: Pointer) of object;
TDownThreadLog = packed record
StartPos: Integer;
Position: Integer;
EndPos: Integer;
end;
PDownThreadLog = ^TDownThreadLog;
TDownThreadLogArr = array of TDownThreadLog;
PDownThreadLogArr = ^TDownThreadLogArr;
TDownLoadThread = class(TThread)
private
FData: Pointer;
FURL: string;
FReturnData: TSubThReturnDataEvent;
FStartPos: Integer;
FEndPos: Integer;
FAimbuf: Pointer;
FWorkCount: Integer;
Http: TIdHTTP;
FThreadLog: PDownThreadLog;
procedure OnHttpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Int64);
function GetHttpConnected: Boolean;
public
procedure Execute; override;
property URL: string read FURL write FURL;
property Data: Pointer read FData write FData;
property ReturnData: TSubThReturnDataEvent read FReturnData write FReturnData;
property StartPos: Integer read FStartPos write FStartPos;
property EndPos: Integer read FEndPos write FEndPos;
property Aimbuf: Pointer read FAimbuf write FAimbuf;
property ThreadLog: PDownThreadLog read FThreadLog write FThreadLog;
property Connected: Boolean read GetHttpConnected;
published
end;
TDLThreadInfo = record
AThread: TDownLoadThread;
Index: Integer;
StartPos: PInteger;
Position: PInteger;
EndPos: PInteger;
URL: string;
end;
PDLThreadInfo = ^TDLThreadInfo;
TDownLoadMng = class(TThread)
private
FList: TList; //线程列表
FBuf: array of Char; //下载缓存
FURL: string;
FWorkCount: Integer;
FReturnData: TReturnDataEvent;
FGetFileSize: TBufReadEvent;
FWorkEnd: TBufReadEvent;
FGetCount: Integer;
FListData: Pointer; //保存界面List指针
FFileName: string;
FDownThreadLog: PDownThreadLogArr; //下载进度保存
FTolSize: Integer;
FSaveToFile: Boolean;
Http: TIdHTTP;
FStop: Boolean; //停止
FPosition: Integer; //开始下载位置
FWorking: Boolean;
procedure OnHttpWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Int64);
procedure CreateSubThread(URL: string; Index, FileSize: Integer; TolIndex: Integer); overload;
procedure CreateSubThread(URL: string; Index: Integer); overload;
procedure DelOneThread(Index: Integer);
procedure SubThreadReturnData(StartPos, WorkCount: Integer; Data: Pointer; var Stop: Boolean);
procedure SaveToFile;
public
constructor Create(CreateSuspended: Boolean);
procedure Execute; override;
procedure Resume;
procedure Suspend;
property URL: string read FURL write FURL;
property ReturnData: TReturnDataEvent read FReturnData write FReturnData;
property GetFileSize: TBufReadEvent read FGetFileSize write FGetFileSize;
property WorkEnd: TBufReadEvent read FWorkEnd write FWorkEnd;
property ListData: Pointer read FListData write FListData;
property FileName: string read FFileName write FFileName;
property DownThreadLog: PDownThreadLogArr read FDownThreadLog write FDownThreadLog;
property Working: Boolean read FWorking;
destructor Destroy; override;
function CheckCanMulDown(URL: string): Boolean;
procedure Stop; //调用此方法后需使用WaitForSingleObject等待线程结束
end;
var
SubThreadCount: Integer = 2; //子线程数
const
FieldSize=1024*256;
ChunkWriteSize = 1024*1024; //每次写文件的大小
CallBackSize =1024*32; //IDHTTP每次回调的大小
implementation
{ TDownLoadThread }
procedure TDownLoadThread.Execute;
var
msStream: TMemoryStream;
begin
inherited;
if not Terminated then FreeOnTerminate := True;
FWorkCount := 0;
http := TIdHTTP.Create(nil);
http.Head(URL);
http.OnWork := OnHttpWork;
try
if (FStartPos > 0) and (FEndPos > 0) and (FAimbuf <> nil) then
begin
Http.Request.ContentRangeStart := FStartPos;
Http.Request.ContentRangeEnd := FEndPos;
msStream := TMemoryStream.Create;
try
Http.Get(FURL, msStream);
finally
msStream.Position := 0;
msStream.Read(FAimbuf^, msStream.Size);
msStream.Free;
end;
end;
finally
Http.Free;
Http := nil;
end;
end;
function TDownLoadThread.GetHttpConnected: Boolean;
begin
Result := Assigned(Http);
if Result then Result := Http.Connected;
end;
procedure TDownLoadThread.OnHttpWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Int64);
var
StopGet: Boolean;
begin
if Terminated then
begin
TIdHTTP(Sender).Disconnect;
Exit;
end;
if (AWorkMode = wmRead) and Assigned(FReturnData) then
begin
FReturnData(FStartPos+FWorkCount, AWorkCount-FWorkCount, FData, StopGet);
FWorkCount := AWorkCount;
end;
end;
{ TDownLoadMng }
function TDownLoadMng.CheckCanMulDown(URL: string): Boolean;
var
Http: TIdHTTP;
S: string;
begin
Result := False;
Http := TIdHTTP.Create(nil);
Http.Head(URL);
Http.Request.ContentRangeStart := 0;
Http.Request.ContentRangeEnd := 1;
Http.HandleRedirects := True;
try
S := Http.Get(URL);
Result := True;
except
end;
Http.Free;
end;
constructor TDownLoadMng.Create(CreateSuspended: Boolean);
begin
inherited;
FList := TList.Create;
FSaveToFile := False;
FStop := False;
end;
procedure TDownLoadMng.CreateSubThread(URL: string; Index,
FileSize: Integer; TolIndex: Integer);
var
DLThreadInfo: PDLThreadInfo;
begin
New(DLThreadInfo);
DLThreadInfo^.AThread := TDownLoadThread.Create(True);
DLThreadInfo^.Index := Index;
DLThreadInfo^.StartPos := @FDownThreadLog^[Index].StartPos;
DLThreadInfo^.StartPos^ := CallBackSize*(Trunc(Index*FileSize/(TolIndex+1)) div CallBackSize)+1;
DLThreadInfo^.Position := @FDownThreadLog^[Index].Position;
DLThreadInfo^.Position^ := DLThreadInfo^.StartPos^;
if TolIndex = Index then
FDownThreadLog^[Index].EndPos := FileSize
else
FDownThreadLog^[Index].EndPos := CallBackSize*(Trunc((Index+1)*FileSize/(TolIndex+1)) div CallBackSize);
DLThreadInfo^.EndPos := @FDownThreadLog^[Index].EndPos;
DLThreadInfo^.URL := URL;
DLThreadInfo^.AThread.URL := URL;
DLThreadInfo^.AThread.Data := DLThreadInfo;
DLThreadInfo^.AThread.StartPos := DLThreadInfo^.StartPos^;
DLThreadInfo^.AThread.EndPos := DLThreadInfo^.EndPos^;
DLThreadInfo^.AThread.Aimbuf := Pointer(PChar(FBuf)+DLThreadInfo^.StartPos^);
DLThreadInfo^.AThread.ReturnData := SubThreadReturnData;
FList.Add(DLThreadInfo);
DLThreadInfo^.AThread.Resume;
end;
procedure TDownLoadMng.CreateSubThread(URL: string; Index: Integer);
var
DLThreadInfo: PDLThreadInfo;
begin
New(DLThreadInfo);
DLThreadInfo^.AThread := TDownLoadThread.Create(True);
DLThreadInfo^.StartPos := @FDownThreadLog^[Index].StartPos;
DLThreadInfo^.Position := @FDownThreadLog^[Index].Position;
DLThreadInfo^.EndPos := @FDownThreadLog^[Index].EndPos;
DLThreadInfo^.URL := URL;
DLThreadInfo^.AThread.URL := URL;
DLThreadInfo^.AThread.Data := DLThreadInfo;
DLThreadInfo^.AThread.StartPos := FDownThreadLog^[Index].Position-1;
DLThreadInfo^.AThread.EndPos := FDownThreadLog^[Index].EndPos;
DLThreadInfo^.AThread.Aimbuf := Pointer(PChar(FBuf)+FDownThreadLog^[Index].Position-1);
DLThreadInfo^.AThread.ReturnData := SubThreadReturnData;
FList.Add(DLThreadInfo);
DLThreadInfo^.AThread.Resume;
end;
procedure TDownLoadMng.DelOneThread(Index: Integer);
begin
if Assigned(PDLThreadInfo(FList.Items[Index])^.AThread) then
TerminateThread(PDLThreadInfo(FList.Items[Index])^.AThread.Handle, 0);
Dispose(PDLThreadInfo(FList.Items[Index]));
FList.Delete(Index);
end;
destructor TDownLoadMng.Destroy;
var
i: Integer;
begin
for i := FList.Count-1 downto 0 do
DelOneThread(i);
FList.Free;
if not FSaveToFile then
SaveToFile;
inherited;
end;
procedure TDownLoadMng.Execute;
var
i, nFileSize, nThreadCount: Integer;
S: string;
bCanMul: Boolean;
fsStream: TFileStream;
begin
inherited;
FWorking := False;
FWorkCount := 0;
SetLength(FBuf, 0);
Http := TIdHTTP.Create(nil);
//得到大小
try
Http.Head(URL);
except
FStop := True;
Http.Free;
exit;
end;
FWorking := True;
nFileSize := Http.Response.ContentLength;
//返回文件大小信息
if Assigned(FGetFileSize) then
FGetFileSize(nil, nFileSize, FListData);
FGetCount := 0; //已下载大小
FPosition := 0;
if (Length(FDownThreadLog^) = 0) or (FDownThreadLog^[High(FDownThreadLog^)].EndPos<>nFileSize)
or (not FileExists(FFileName)) then
begin //New Job or 文件大小不一致 or 文件不存在
FTolSize := nFileSize;
SetLength(FBuf, FTolSize);
//查看是否可以分块下载
bCanMul := CheckCanMulDown(URL);
//文件大小大于FieldSize创建子线程
if bCanMul and (nFileSize > FieldSize) and (SubThreadCount>0) then
begin
SetLength(FDownThreadLog^, SubThreadCount+1);
for i := 1 to SubThreadCount do
CreateSubThread(URL, i, nFileSize, SubThreadCount);
nFileSize := CallBackSize*(Trunc(nFileSize/(SubThreadCount+1)) div CallBackSize);
end
else
SetLength(FDownThreadLog^, 1);
FDownThreadLog^[0].StartPos := 0;
FDownThreadLog^[0].EndPos := nFileSize;
Http.OnWork := OnHttpWork;
if Length(FDownThreadLog^)>1 then
begin
Http.Request.ContentRangeStart := 0;
Http.Request.ContentRangeEnd := nFileSize;
end;
end
else
begin //续传
FTolSize := 0; //需要下载的大小
for i := Low(FDownThreadLog^) to High(FDownThreadLog^) do
FTolSize := FTolSize+FDownThreadLog^[i].EndPos-FDownThreadLog^[i].Position+1;
//读取文件
try
fsStream := TFileStream.Create(FFileName, fmOpenRead);
except
//文件被占用，返回停止
Http.Free;
if Assigned(FWorkEnd) then FWorkEnd(@FBuf, 0, FListData);
exit;
end;
SetLength(FBuf, fsStream.Size);
fsStream.Position := 0;
fsStream.Read(Pointer(FBuf)^, fsStream.Size);
fsStream.Free;
//得到需要创建的线程数
nThreadCount := 0;
for i := Low(FDownThreadLog^) to High(FDownThreadLog^) do
if FDownThreadLog^[i].EndPos>FDownThreadLog^[i].Position then Inc(nThreadCount);
//查看是否可以分块下载
//bCanMul := CheckCanMulDown(URL);
//创建子线程
i := High(FDownThreadLog^);
while nThreadCount > 1 do
begin
if FDownThreadLog^[i].EndPos > FDownThreadLog^[i].Position then
begin
CreateSubThread(URL, i);
Dec(nThreadCount);
end;
Dec(i);
end;
for i := Low(FDownThreadLog^) to High(FDownThreadLog^) do
begin
if FDownThreadLog^[i].EndPos>FDownThreadLog^[i].Position then
begin
if FDownThreadLog^[i].Position-1 > 0 then
Http.Request.ContentRangeStart := FDownThreadLog^[i].Position-1
else
Http.Request.ContentRangeStart := 0;
FPosition := Http.Request.ContentRangeStart;
Http.Request.ContentRangeEnd := FDownThreadLog^[i].EndPos;
Break;
end;
end;
Http.OnWork := OnHttpWork;
end;
//主线程下载
try
try
S := Http.Get(FURL);
CopyMemory(Pointer(PChar(FBuf)+Http.Request.ContentRangeStart), Pointer(S), Length(S));
except
FStop := True;
end
finally
Http.Free;
end;
//等待子线程下载
while (FGetCount<FTolSize) and not FStop do
begin
Sleep(50);
end;
SaveToFile;
end;
procedure TDownLoadMng.OnHttpWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Int64);
begin
if FStop then
begin
TIdHTTP(Sender).Disconnect;
Exit;
end;
if Assigned(FReturnData) then
begin
FDownThreadLog^[0].Position := AWorkCount+FPosition;
FReturnData(FWorkCount, AWorkCount-FWorkCount, FListData);
Inc(FGetCount, AWorkCount-FWorkCount);
FWorkCount := AWorkCount;
end;
end;
procedure TDownLoadMng.Resume;
var
i: Integer;
begin
inherited;
for i := FList.Count-1 downto 0 do
PDLThreadInfo(FList.Items[i])^.AThread.Resume;
end;
procedure TDownLoadMng.SaveToFile;
var
fsStream: TFileStream;
i: Integer;
begin
//等子线程写入
for i := 0 to FList.Count-1 do
Sleep(200);
//写文件
fsStream := TFileStream.Create(FFileName, fmCreate);
fsStream.Size := FTolSize;
fsStream.Position := 0;
fsStream.Write(Pointer(FBuf)^, Length(FBuf));
fsStream.Free;
FSaveToFile := True;
if (FGetCount >= FTolSize) and Assigned(FWorkEnd) then FWorkEnd(PChar(FBuf), Length(FBuf), FListData);
end;
procedure TDownLoadMng.Stop;
var
i: Integer;
begin
for i := FList.Count-1 downto 0 do
begin
if Assigned(PDLThreadInfo(FList.Items[i])^.AThread) then
begin
PDLThreadInfo(FList.Items[i])^.AThread.Terminate;
PDLThreadInfo(FList.Items[i])^.AThread := nil;
end;
end;
FStop := True;
end;
procedure TDownLoadMng.SubThreadReturnData(StartPos, WorkCount: Integer;
Data: Pointer; var Stop: Boolean);
begin
if Assigned(FReturnData) then
FReturnData(PDLThreadInfo(Data)^.Position^, WorkCount, FListData);
Inc(FGetCount, WorkCount);
PDLThreadInfo(Data)^.Position^ := StartPos + WorkCount;
end;
procedure TDownLoadMng.Suspend;
var
i: Integer;
begin
for i := FList.Count-1 downto 0 do
PDLThreadInfo(FList.Items[i])^.AThread.Suspend;
inherited;
end;
end.