用Delphi實現整個網站圖片的極速下載 
--------------------------------------------------------------------------------
作者：不詳 　來源于：不詳 　發布時間：2005-2-18 4:35:23 
  
今天在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.