S
smlabc
Unregistered / Unconfirmed
GUEST, unregistred user!
{*******************************************************}{ }{ Indy 9.0.50 多线程下载 }{ }{ 版权所有 (C) 2008 }{ }{*******************************************************}unit IndyDownLoadFile;interfaceuses 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^.EndPos-FDownThreadLog^.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^.EndPos>FDownThreadLog^.Position then Inc(nThreadCount); //查看是否可以分块下载 //bCanMul := CheckCanMulDown(URL); //创建子线程 i := High(FDownThreadLog^); while nThreadCount > 1 do begin if FDownThreadLog^.EndPos > FDownThreadLog^.Position then begin CreateSubThread(URL, i); Dec(nThreadCount); end; Dec(i); end; for i := Low(FDownThreadLog^) to High(FDownThreadLog^) do begin if FDownThreadLog^.EndPos>FDownThreadLog^.Position then begin if FDownThreadLog^.Position-1 > 0 then Http.Request.ContentRangeStart := FDownThreadLog^.Position-1 else Http.Request.ContentRangeStart := 0; FPosition := Http.Request.ContentRangeStart; Http.Request.ContentRangeEnd := FDownThreadLog^.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)^.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)^.AThread) then begin PDLThreadInfo(FList.Items)^.AThread.Terminate; PDLThreadInfo(FList.Items)^.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)^.AThread.Suspend; inherited;end;end.