zoukankan      html  css  js  c++  java
  • 利用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; 
    
  • 相关阅读:
    【转载】 C#中使用Sum方法对List集合进行求和操作
    【转载】 C#中使用Count方法获取List集合中符合条件的个数
    【转载】C#使用FirstOrDefault方法快速查找List集合中符合条件的第一个实体
    【转载】Windows检测到IP地址冲突
    【转载】Asp.Net MVC网站提交富文本HTML标签内容抛出异常
    java笔试题(4)
    Android -- TouchEvent的分发和截获方式
    SQL优化
    Android -- 经验分享(二)
    设计模式(十二)外观模式(结构型)
  • 原文地址:https://www.cnblogs.com/sail2000/p/1760578.html
Copyright © 2011-2022 走看看