Linux中国 Linux中国门户站!
设为主页 设为主页
收藏本站 收藏本站
 
当前位置 :首页 ->编程语言 ->Delphi ->正文

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

来源:Linuxdby.com 作者:Webmaster 时间:2007-06-05 点击: [收藏] [投稿]

今天在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 !');

 如果您对本文有任何疑问或者建议,请到讨论区发表您的意见: >> 论坛入口 <<



上一篇:Delphi控制Excel2000   下一篇:在Delphi中获取和修改文件的时间

文章评论】 【收藏本文】 【推荐好友】 【打印本文】 【我要投稿】 【论坛讨论
更多相关文章
Power by linux-cn.com 粤ICP备05006655号