用Delphi實現整個網站圖片的極速下載

　　今天在s8s8上看到一個帖子，http://www.s8s8.Net/forums/index.php?showtopic=13495人氣極旺，大家用不同的語言和腳本來下載一個網站上的MM照片，有shell腳本的，c語言的，C++的，vbs的，PHP的，perl的，還有Java的和C#的，可謂百花齊放，一時興起，我也寫了個Delphi版本的，使用了多線程，基本上不到半個小時就把幾千張照片全部Down了下來，不過看了幾張，全都是少兒不宜，難怪那些SL們都爭先恐後，當然，我也不例外了：）

　　
　　程序完整代碼：
　　//寫的比較粗糙，但基本能實現下載功能，管不了那麼多了。
　　unit GetMM;

　　interface

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

　　const
　　  Url='http://www.sergeaura.Net/TGP/';  //下載圖片的網站地址
　　  OffI=192; //目錄個數
　　  OffJ=16;  //每個目錄下的最大圖片數
　　  girlPic='C:girlPic';  //保存在本地的路徑

　　//線程類
　　type
　　  TGetMM = class(TThread)
　　  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;
　　    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;

　　implementation

　　{$R *.dfm}

　　//下載過程
　　procedure TForm1.Button1Click(Sender: TObject);
　　var
　　  i,j:integer;
　　  SubI,SubJ,CurUrl,DestPath:string;
　　  strm:TMemoryStream;
　　begin
　　  memo1.Lines.Clear;
　　  //建立目錄
　　  if not DirectoryExists(girlPic) then
　　    MkDir(girlPic);
　　  try
　　    strm :=TMemoryStream.Create;
　　    for I:=1 to OffI do
　　    begin
　　      for j:=1 to OffJ do
　　      begin
　　        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
　　          GetMMThread(CurUrl,DestPath,SubJ);
　　          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);
　　begin
　　  Close; 
　　end;

　　{ TGetMM }

　　constructor TGetMM.Create(MMUrl,DestPath,SubJ: string);
　　begin
　　  FMMUrl :=MMUrl;
　　  FDestPath :=DestPath;
　　  FSubJ :=SubJ;
　　  inherited Create(False);
　　end;

　　procedure TGetMM.Execute;
　　var
　　  strm:TMemoryStream;
　　  IdGetMM: TIdHTTP;
　　  DestFile:string;
　　begin
　　  try
　　    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
　　    strm.Free;
　　    IdGetMM.Free;
　　  end;
　　end;

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

　　end.