利用IdHTTP进行多线程下载
必须补充说明的是:这个例子是 delphi7 + indy 9.00.10 的,不保证其他版本 delphi/indy 例子能够使用。
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze, IdThreadComponent, IdFTP; 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; IdThreadComponent1: TIdThreadComponent; Label1: TLabel; Label2: TLabel; Button2: TButton; Button3: TButton; ListBox1: TListBox; Edit1: TEdit; Edit2: TEdit; Label3: TLabel; Label4: TLabel; 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; MyThread: array[1..10] of TThread; procedure GetThread(); procedure AddFile(); 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 tcount := 0; Showmessage('OK!主线程在执行,获得文件名并显示在Edit2中'); aURL := Edit1.Text; //下载地址 aFile := GetURLFileName(Edit1.Text); //得到文件名 nn := StrToInt(Edit2.Text); //线程数 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; end; //开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小. procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin AbortTransfer := False; 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); begin AbortTransfer := True; 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; 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 i := 1; mStream1 := TMemoryStream.Create; mStream2 := TMemoryStream.Create; mStream1.loadfromfile('设备工程进度管理前期规划.doc' + '1'); while i < nn do begin mStream2.loadfromfile('设备工程进度管理前期规划.doc' + IntToStr(i + 1)); mStream1.seek(mStream1.size, soFromBeginning); mStream1.copyfrom(mStream2, mStream2.size); mStream2.clear; i := i + 1; end; mStream2.free; mStream1.SaveToFile('设备工程进度管理前期规划.doc'); mStream1.free; //删除临时文件 i:=1; while i <= nn do begin deletefile('设备工程进度管理前期规划.doc' + IntToStr(i)); i := i + 1; end; Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('下在成功'); 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); //开始下载 Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(temFileName + 'download'); finally //tStream.Free; 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 //Showmessage('全部下载成功!'); Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件'); Form1.AddFile; end; end; end. +++++++++++++++++++++++++++++++++++++++++++++++++++++ ^知道了可以用nmhttp控件下载网页,可是D7找不到这个控件了。 ^找到了idhttp控件似乎可以实现相同的功能,可是线上关于其的讨论太少 ^摘录一点代码: ____________________________________________________________________________________________ 直接采用Delphi自带的控件的INDY组件为例.新建一个工程,放上一个TIdHTTP控件,一个TIdAntiFreeze控件,一个TProgressBar用于显示下载进度.最后放上一个TButton用于开始执行我们的命令.代码如下: procedure TForm1.Button1Click(Sender: TObject);//点击按钮的时候开始下载我们的文件 var MyStream:TMemoryStream; begin IdAntiFreeze1.OnlyWhenIdle:=False;//设置使程序有反应. MyStream:=TMemoryStream.Create; try IdHTTP1.Get('http://www.138soft.com/download/Mp3ToExe.zip',MyStream);//下载我站点的一个ZIP文件 except//INDY控件一般要使用这种try..except结构. Showmessage('网络出错!'); MyStream.Free; Exit; end; MyStream.SaveToFile('c:\Mp3ToExe.zip'); MyStream.Free; Showmessage('OK'); end; procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);//开始下载前,将ProgressBar1的最大值设置为需要接收的数据大小. begin ProgressBar1.Max:=AWorkCountMax; ProgressBar1.Min:=0; ProgressBar1.Position:=0; end; procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);//接收数据的时候,进度将在ProgressBar1显示出来. begin ProgressBar1.Position:=ProgressBar1.Position+AWorkCount; end; IdHTTP1的Get还有一种形式就是获取字符串:例如,上面的程序可以改写成: procedure TForm1.Button1Click(Sender: TObject); var MyStr:String; begin IdAntiFreeze1.OnlyWhenIdle:=False;//设置使程序有反应. try MyStr:=IdHTTP1.Get('http://www.138soft.com/default.htm'); except Showmessage('网络出错!'); Exit; end; Showmessage(MyStr); end;