用Delphi实现整个网站图片的极速下载

核心提示：今天在s8s8上看到一个帖子，http://www.s8s8.net/forums/index.php?showtopic=13495人气极旺，用Delphi实现整个网站图片的极速下载，大家用不同的语言和脚本来下载一个网站上的MM照片，有shell脚本的，但基本能实现下载功能，管不了那么多了，c语言的，C++的

今天在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.