多线程idhttp下载文件源代码

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,

IdHTTP, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze,

IdThreadComponent, IdFTP ,IdException;

type

MyException1 = class(exception)//自定义的异常类

end;

type

TThread1 = class(TThread)

private

fCount, tstart, tlast: integer;

tURL, tFile, temFileName: string;

tResume: Boolean;

tStream: TFileStream;

protected

procedure Execute; override;

public

constructor create1(aURL, aFile, fileName: string; bResume: Boolean; Count,

start, last: integer);

procedure DownLodeFile(); //下载文件

end;

type

TForm1 = class(TForm)

IdAntiFreeze1: TIdAntiFreeze;

IdHTTP1: TIdHTTP;

Button1: TButton;

ProgressBar1: TProgressBar;

Label1: TLabel;

Label2: TLabel;

Button2: TButton;

Button3: TButton;

ListBox1: TListBox;

Edit1: TEdit;

Edit2: TEdit;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

SaveDialog1: TSaveDialog;

procedure Button1Click(Sender: TObject);

procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;

const AWorkCountMax: Integer);

procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;

const AWorkCount: Integer);

procedure Button2Click(Sender: TObject);

procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;

const AStatusText: string);

procedure Button3Click(Sender: TObject);

private

public

nn, aFileSize, avg: integer;

time1, time2: TDateTime;

MyThread: array[1..10] of TThread;

procedure GetThread();

procedure AddFile();

procedure NewAddFile();

function GetURLFileName(aURL: string): string;

function GetFileSize(aURL: string): integer;

end;

var

Form1: TForm1;

implementation

var

AbortTransfer: Boolean;

aURL, aFile: string;

tcount: integer; //检查文件是否全部下载完毕

{$R *.dfm}

//get FileName

function TForm1.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;

//get FileSize

function TForm1.GetFileSize(aURL: string): integer;

var

FileSize: integer;

begin

IdHTTP1.Head(aURL);

FileSize := IdHTTP1.Response.ContentLength;

IdHTTP1.Disconnect;

Result := FileSize;

end;

//执行下载

procedure TForm1.Button1Click(Sender: TObject);

var

j: integer;

begin

//savedialog1.

try

time1 := Now;

tcount := 0;

aURL := Edit1.Text; //下载地址

if aURL = '' then

begin

MessageDlg('请输入下载地址！',mtError,[mbOK],0);

Exit;

end;

aFile := GetURLFileName(Edit1.Text); //得到文件名

savedialog1.FileName :=afile;

if savedialog1.Execute then

if Edit2.Text = '' then

begin

case MessageDlg('请输入线程数，最大支持10个线程，默认为单线程下载！', mtConfirmation, [mbYes, mbNo], 0) of

mrYes: nn:=1; //默认

mrNo: Exit; //重新输入

end;

end

else

nn := StrToInt(Edit2.Text); //线程数

if nn > 10 then

begin

raise MyException1.Create('输入超过线程限制数，请重新输入！');

end;

j := 1;

aFileSize := GetFileSize(aURL);

avg := trunc(aFileSize / nn);

begin

try

GetThread();

while j <= nn do

begin

MyThread[j].Resume; //唤醒线程

j := j + 1;

end;

except

Showmessage('创建线程失败!');

Exit;

end;

end;

except

on E:EConvertError do//捕捉内建的Econverterror异常

begin

//ShowMessage('请输入数字');

MessageDlg('请输入数字'+#13,mtError,[mbOK],0);

Exit;

end;

on E:MyException1 do//捕捉自定义的MyException异常

begin

MessageDlg(E.Message,mtError,[mbOK],0);

Edit2.Text:= '';

Exit;

end;

on E:EIdSocketError do//捕捉内建的EIdSocketError异常

begin

MessageDlg('连接不上服务器，或服务起未开启！',mtError,[mbOK],0);

Exit;

end;

on E:EIdConnectException do//捕捉内建的EIdSocketError异常

begin

MessageDlg('连接不上服务器，或服务起未开启！',mtError,[mbOK],0);

Exit;

end;

on E:EIdHTTPProtocolException do//捕捉内建的EIdSocketError异常

begin

MessageDlg('目标文件找不到！',mtError,[mbOK],0);

Exit;

end;

else

raise //reraise其他异常

end;

end;

//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小.

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;

const AWorkCountMax: Integer);

begin

AbortTransfer := true;

ProgressBar1.Max := AWorkCountMax;

ProgressBar1.Min := 0;

ProgressBar1.Position := 0;

end;

//接收数据的时候,进度将在ProgressBar1显示出来.

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;

const AWorkCount: Integer);

begin

if AbortTransfer then

begin

//IdHTTP1.Disconnect; //中断下载

end;

ProgressBar1.Position := AWorkCount;

//ProgressBar1.Position:=ProgressBar1.Position+AWorkCount; //*******显示速度极快

Application.ProcessMessages;

//***********************************这样使用不知道对不对

end;

//中断下载

procedure TForm1.Button2Click(Sender: TObject);

var

i : integer;

begin

try

if AbortTransfer then

begin

i:=1;

while i <= nn do

begin

MyThread[i].Suspend;

i := i + 1;

end;

AbortTransfer := false;

button2.Caption:='开始';

end else

begin

i:=1;

while i <= nn do

begin

MyThread[i].Resume;

i := i + 1;

end;

AbortTransfer := True;

button2.Caption:='暂停';

end;

except

on E:EThread do

begin

end;

else

raise //reraise其他异常

end;

//IdHTTP1.Disconnect;

end;

//状态显示

procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;

const AStatusText: string);

begin

ListBox1.ItemIndex := ListBox1.Items.Add(AStatusText);

end;

//退出程序

procedure TForm1.Button3Click(Sender: TObject);

begin

//application.Terminate;

IdHTTP1.DisconnectSocket;

Form1.close;

end;

//循环产生线程

procedure TForm1.GetThread();

var

i: integer;

start: array[1..100] of integer;

last: array[1..100] of integer; //改用了数组，也可不用

fileName: string;

begin

i := 1;

while i <= nn do

begin

start[i] := avg * (i - 1);

last[i] := avg * i -1; //这里原先是last:=avg*i;

if i = nn then

begin

last[i] := avg*i + aFileSize-avg*nn; //这里原先是aFileSize

end;

fileName := aFile + IntToStr(i);

MyThread[i] := TThread1.create1(aURL, aFile, fileName, false, i, start[i],

last[i]);

i := i + 1;

end;

end;

procedure TForm1.AddFile(); //合并文件

var

mStream1, mStream2: TMemoryStream;

i: integer;

begin

try

i := 1;

mStream1 := TMemoryStream.Create;

mStream2 := TMemoryStream.Create;

mStream1.loadfromfile(afile + '1');

while i < nn do

begin

mStream2.loadfromfile(afile + IntToStr(i + 1));

mStream1.seek(mStream1.size, soFromBeginning);

mStream1.copyfrom(mStream2, mStream2.size);

mStream2.clear;

i := i + 1;

end;

FreeAndNil(mStream2);

mStream1.SaveToFile(afile);

FreeAndNil(mStream1);

//删除临时文件

i:=1;

while i <= nn do

begin

deletefile(afile + IntToStr(i));

i := i + 1;

end;

Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下载成功');

except

i:=1;

while i <= nn do

begin

if FileExists(aFile+inttostr(i)) then

deletefile(afile + IntToStr(i));

i := i + 1;

end;

ShowMessage('下载文件出错，临时文件已删除，请重新下载！')

end;

end;

procedure TForm1.NewAddFile(); //合并文件

var

i: Integer;

InStream, OutStream : TFileStream;

SourceFile : String;

begin

try

i := 1;

OutStream:=TFileStream.Create(aFile,fmCreate);

//OutStream:=TFileStream.Create(('D/1/'+aFile),fmCreate); //此句与savedialog冲突，发生异常，使savedialog指定路径无效。

while i <= nn do

begin

SourceFile := afile + IntToStr(i);

InStream:=TFileStream.Create(SourceFile, fmOpenRead);

OutStream.CopyFrom(InStream,0);

FreeAndNil(InStream);

i:= i+1;

end;

FreeAndNil(OutStream);

//删除临时文件

i:=1;

while i <= nn do

begin

deletefile(afile + IntToStr(i));

i := i + 1;

end;

except

i:=1;

while i <= nn do

begin

if FileExists(aFile+inttostr(i)) then

deletefile(afile + IntToStr(i));

i := i + 1;

end;

end;

if FileExists(aFile) then

begin

FreeAndNil(OutStream);

InStream := TFileStream.Create(aFile, fmOpenWrite);

if InStream.Size < aFileSize then

begin

FreeAndNil(InStream);

deletefile(afile);

//ShowMessage('下载文件出错，临时文件已删除，请重新下载！')

Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下载文件出错，临时文件已删除，请重新下载！');

end

else

begin

FreeAndNil(InStream);

Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功');

end;

end;

end;

//构造函数

constructor TThread1.create1(aURL, aFile, fileName: string; bResume: Boolean;

Count, start, last: integer);

begin

inherited create(true);

FreeOnTerminate := true;

tURL := aURL;

tFile := aFile;

fCount := Count;

tResume := bResume;

tstart := start;

tlast := last;

temFileName := fileName;

end;

//下载文件函数

procedure TThread1.DownLodeFile();

var

temhttp: TIdHTTP;

begin

temhttp := TIdHTTP.Create(nil);

temhttp.onWorkBegin := Form1.IdHTTP1WorkBegin;

temhttp.onwork := Form1.IdHTTP1work;

temhttp.onStatus := Form1.IdHTTP1Status;

Form1.IdAntiFreeze1.OnlyWhenIdle := False; //设置使程序有反应.

if FileExists(temFileName) then //如果文件已经存在

tStream := TFileStream.Create(temFileName, fmOpenWrite)

else

tStream := TFileStream.Create(temFileName, fmCreate);

if tResume then //续传方式

begin

exit;

end

else //覆盖或新建方式

begin

temhttp.Request.ContentRangeStart := tstart;

temhttp.Request.ContentRangeEnd := tlast;

end;

try

///try

temhttp.Get(tURL, tStream); //开始下载

except

if FileExists(temFileName) then

begin

freeandnil(tstream);

deletefile(temFileName);//本来想用来删除未下完的文件，可惜不成功，有的线程没有删除，只有部分删除了，

//不过这样导致后面合并文件时出错，同样也可以把临时文件删除。

//ShowMessage('下载文件出错，临时文件已删除，请重新下载！');/

end;

temhttp.Disconnect;

end;

Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +

'download');

//finally

freeandnil(tstream);

temhttp.Disconnect;

//end;

end;

procedure TThread1.Execute;

begin

if Form1.Edit1.Text <> '' then

//synchronize(DownLodeFile)

DownLodeFile

else

exit;

inc(tcount);

if tcount = Form1.nn then //当tcount=nn时代表全部下载成功

begin

Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');

Form1.NewAddFile;

form1.time2 := Now;

Form1.Label5.Caption := FormatDateTime ('n:ss', form1.Time2-Form1.Time1) + ' seconds';

end;

end;

end.