unitmutithreadmainform.pas

查找并替换所有文本中的文字

unit UnitMutiThreadMainForm;

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;
    fTcount: integer;
    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;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    SaveDialog1: TSaveDialog;
    Edit2: TEdit;
    Label2: 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;
    tcount: 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;
    procedure DownLoadPic(URL,saveFullName:string;ThreadCount :integer);
    procedure exitEXE;
  end;

var
  Form1: TForm1;

implementation
var
  AbortTransfer: Boolean;
  aURL, aFile: string;

{$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;
    form1.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
  exitExE;

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
    ListBox1.Items.Add('合并');
    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
    //synchronize(DownLodeFile)
  DownLodeFile;
  inc(form1.tcount);
  form1.ListBox1.Items.Add( inttostr(form1.tcount)+'-'+inttostr(form1.nn));
  if form1.tcount = Form1.nn then //当tcount=nn时代表全部下载成功
  begin
    Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add('正在合并删除临时文件');
    Form1.NewAddFile;
    form1.time2 := Now;
  end;

end;

procedure TForm1.DownLoadPic(URL,saveFullName: string;  ThreadCount :integer);
var
  j: integer;
begin
    //savedialog1.

  try
    time1 := Now;
    form1.tcount := 0;
    aURL := url; //下载地址
    aFile:=  saveFullName;     //保存地址
    if aURL = '' then
    begin
       //MessageDlg('请输入下载地址！',mtError,[mbOK],0);
       //Exit;
    end;
    nn := ThreadCount; //线程数
    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;

procedure TForm1.exitEXE;
begin
  //application.Terminate;
  IdHTTP1.DisconnectSocket;
  Form1.close;
end;

end.