多线程idhttp下载文件源代码
来源:互联网 发布:神经网络算法过程 编辑:程序博客网 时间:2024/06/09 19:53
- 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}
-
- 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;
- 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
-
- 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
- begin
-
- MessageDlg('请输入数字'+#13,mtError,[mbOK],0);
- Exit;
- end;
- on E:MyException1 do
- begin
- MessageDlg(E.Message,mtError,[mbOK],0);
- Edit2.Text:= '';
- Exit;
- end;
- on E:EIdSocketError do
- begin
- MessageDlg('连接不上服务器,或服务起未开启!',mtError,[mbOK],0);
- Exit;
- end;
- on E:EIdConnectException do
- begin
- MessageDlg('连接不上服务器,或服务起未开启!',mtError,[mbOK],0);
- Exit;
- end;
- on E:EIdHTTPProtocolException do
- begin
- MessageDlg('目标文件找不到!',mtError,[mbOK],0);
- Exit;
- end;
- else
- raise
- end;
- end;
- procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
- const AWorkCountMax: Integer);
- begin
- AbortTransfer := true;
- ProgressBar1.Max := AWorkCountMax;
- ProgressBar1.Min := 0;
- ProgressBar1.Position := 0;
- end;
- procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
- const AWorkCount: Integer);
- begin
- if AbortTransfer then
- begin
-
- end;
- 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
- end;
-
- 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
-
- 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;
- if i = nn then
- begin
- last[i] := avg*i + aFileSize-avg*nn;
- 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);
-
- 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);
-
- 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
-
- temhttp.Get(tURL, tStream);
- except
- if FileExists(temFileName) then
- begin
- freeandnil(tstream);
- deletefile(temFileName);
-
-
- end;
- temhttp.Disconnect;
- end;
- Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName +
- 'download');
-
- freeandnil(tstream);
- temhttp.Disconnect;
-
- end;
- procedure TThread1.Execute;
- begin
- if Form1.Edit1.Text <> '' then
-
- DownLodeFile
- else
- exit;
- inc(tcount);
- if tcount = Form1.nn then
- 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.