多线程下载

unit GetMM;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP;

const
Url='[url]http://www.sergeaura.net/TGP/[/url]'; //下载图片的网站地址
OffI=5; //目录个数
OffJ=16; //每个目录下的最大图片数
girlPic='C:\girlPic\'; //保存在本地的路径
maxThread=100;     //最大线程数目
//线程类
type
TGetMM = class(TThread)
private
  procedure decTcount;
  procedure incTcount;
protected
  FMMUrl:string;
  FDestPath:string;
  FSubJ:string;
  procedure Execute;override;
public
  constructor Create(MMUrl,DestPath,SubJ:string);
end;

type
TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  Memo1: TMemo;
  IdHTTP1: TIdHTTP;
  CheckBox1: TCheckBox;
  Label1: TLabel;
  Edit1: TEdit;
  Edit2: TEdit;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
private
  { Private declarations }
  RGetMM:TThread;
  procedure GetMMThread(MMUrl,DestPath,SubJ:string);
public
  { Public declarations }
end;

var
Form1: TForm1;
flag:boolean;
tcount:integer; //用来控制当前下载线程用
implementation

{$R *.dfm}

//下载过程
procedure TForm1.Button1Click(Sender: TObject);
var
i,j:integer;
SubI,SubJ,CurUrl,DestPath:string;
strm:TMemoryStream;
begin
tcount:=0;
memo1.Lines.Clear;
//建立目录
if not DirectoryExists(girlPic) then
  MkDir(girlPic);
try
  strm :=TMemoryStream.Create;
  for I:=strtoint(edit1.text) to strtoint(edit2.text) do
  begin
    for j:=1 to OffJ do
    begin
    flag:=false;
    if (i<10) then
      SubI:='00'+IntToStr(i)
    else if (i>9) and (i<100) then
      SubI:='0'+inttostr(i)
    else SubI:=inttostr(i);
    if (j>9) then
      SubJ:=inttostr(j)
    else SubJ:='0'+inttostr(j);
    CurUrl:=Url+SubI+'/images/';
    DestPath:=girlPic+SubI+'\';
    if not DirectoryExists(DestPath) then
      ForceDirectories(DestPath);
    //使用线程，速度能提高N倍以上
    if CheckBox1.Checked then
    begin
      while flag=false do
      begin
      if tcount<50 then
        begin
        GetMMThread(CurUrl,DestPath,SubJ);
        flag:=true;
        end;

        label1.Caption:=inttostr(tcount);
        application.ProcessMessages;
      end;
      //sleep(500);

    end else
    //不使用线程
    begin
      try
        strm.Clear;
        IdHTTP1.Get(CurUrl+SubJ+'.jpg',strm);
        strm.SaveToFile(DestPath+SubJ+'.jpg');
        Memo1.Lines.Add(CurUrl+' Download OK ！');
        strm.Clear;
        IdHTTP1.Get(CurUrl+'tn_'+SubJ+'.jpg',strm);
        strm.SaveToFile(DestPath+'tn_'+SubJ+'.jpg');
        Memo1.Lines.Add(CurUrl+' Download OK ！');
      except
        Memo1.Lines.Add(CurUrl+' Download Error ！');
      end;
    end;
    end;
  end;
  Memo1.Lines.Add('All OK！');
finally
  strm.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var x:TMultiReadExclusiveWriteSynchronizer;
begin
Close;
x:=TMultiReadExclusiveWriteSynchronizer.Create;
x.BeginRead;

end;

{ TGetMM }

constructor TGetMM.Create(MMUrl,DestPath,SubJ: string);
begin
FMMUrl :=MMUrl;
FDestPath :=DestPath;
FSubJ :=SubJ;
inherited Create(False);
end;
procedure TGetMM.decTcount;
begin
dec(tcount);
end;
procedure TGetMM.incTcount;
begin
inc(tcount);
end;
procedure TGetMM.Execute;
var
strm:TMemoryStream;
IdGetMM: TIdHTTP;
DestFile:string;
begin
inc(tcount);
//synchronize(incTcount);
try
  //inc(tcount);
  strm :=TMemoryStream.Create;
  IdGetMM :=TIdHTTP.Create(nil);
  try
    DestFile :=FDestPath+FSubJ+'.jpg';
    if Not FileExists(DestFile) then
    begin
    strm.Clear;
    IdGetMM.Get(FMMUrl+FSubJ+'.jpg',strm);
    strm.SaveToFile(DestFile);
    end;
    DestFile :=FDestPath+'tn_'+FSubJ+'.jpg';
    if not FileExists(DestFile) then
    begin
    strm.Clear;
    IdGetMM.Get(FMMUrl+'tn_'+FSubJ+'.jpg',strm);
    strm.SaveToFile(DestFile);
    end;
  except
  end;
finally
  // dec(tcount);
  strm.Free;
  IdGetMM.Free;
end;
dec(tcount);
//synchronize(dectcount);
end;

procedure TForm1.GetMMThread(MMUrl, DestPath, SubJ: string);
begin
RGetMM :=TGetMM.Create(MMUrl,DestPath,SubJ);
end;

end.