delphi 利用IdHTTP进行多线程下载

网络 Delphi

本文整理自网络，侵删。

 
利用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;

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.3464.com/default.htm');
except
Showmessage('网络出错!');
Exit;
end;
Showmessage(MyStr);
end;

相关阅读 >>

Delphi 数据类型列表

Delphi如何获取硬盘所有的分区容量

Delphi 判断字符串是否包含汉字，正则版和非正则版

Delphi 如何在程序中动态设置墙纸（使用iactivedesktop接口）

Delphi动态创建组件，并释放内存

Delphi 从数组中任取一个

Delphi读取xml文件

Delphi打印timage图片

Delphi 增加/获得windows用户帐号

Delphi randomfrom 随机返回字符串数组avalues中的一个元素

更多相关阅读请进入《Delphi》频道 >>



标签：

打赏

取消

感谢您的支持，我会继续努力的!

扫码支持
扫码打赏，您说多少就多少

打开支付宝扫一扫，即可进行扫码打赏哦

分享从这里开始，精彩与您同在

相关推荐

评论

管理员已关闭评论功能...