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

转载 2004年10月01日 21:22:00


程序完整代码:
//写的比较粗糙,但基本能实现下载功能,管不了那么多了。
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.

如何用wget下载整个网站

如何下载整个网站 wget --mirror -p --html-extension --convert-links -e robots=off -P . http://url-to-site...
  • redmoon729
  • redmoon729
  • 2015年01月07日 14:27
  • 2178

C# 网络编程之网页简单下载实现

这是一个C#网页简单下载器,其中涉及到的知识主要是HTTP协议编程中相关类:HttpWebRequest类、HttpWebResponse类、WebRequest类、WebResponse类、Uri类...
  • Eastmount
  • Eastmount
  • 2013年07月30日 16:29
  • 4718

wget 递归下载整个网站

wget命令详解 wget -r -p -np -k http://xxx.com/xxx -r, --recursive(递归) specify recursive download.(指定递...
  • sun_nan_vip
  • sun_nan_vip
  • 2017年05月26日 09:47
  • 1025

wget 下载整个网站,或者特定目录

转载自:http://www.cnblogs.com/lidp/archive/2010/03/02/1696447.html 需要下载某个目录下面的所有文件。命令如下 wget -c -r ...
  • memray
  • memray
  • 2013年09月16日 23:44
  • 41454

用Wget下载整个网站

原文地址: http://www.linuxjournal.com/content/downloading-entire-web-site-wget 也许你曾需要下载整个站点,比如是想离线浏览...
  • pdcxs007
  • pdcxs007
  • 2015年09月27日 19:01
  • 1060

如何下载一个网站的整个目录

最近需要下载一些资料,但是有的是一个文集夹的多个文件,于是想到了wget,看了看手册太多了,希望能快点查到,于是在网上查了一圈,在http://www.lslnet.com/linux/docs/li...
  • zg_hover
  • zg_hover
  • 2009年02月19日 11:15
  • 11093

win下安装wget以及使用wget下载整个网站或目录

1、 安装wget网址:http://gnuwin32.sourceforge.net/packages/wget.htm下载http://downloads.sourceforge.net/gnuw...
  • forever0wind
  • forever0wind
  • 2011年07月03日 17:01
  • 1913

利用wget 抓取 网站网页 包括css背景图片

wget是一款非常优秀的http/ftp下载工具,它功能强大,而且几乎所有的unix系统上都有。不过用它来dump比较现代的网站会有一个问题:不支持css文件,它不会自动下载、重新链接css中所指定的...
  • cb_121
  • cb_121
  • 2009年08月20日 12:44
  • 8696

python 下载整个网站

用python实现的下载整个网站工具。 核心流程很简单: 1. 输入网站地址 2. url,得到响应的内容。 3. 根据响应的http报文头,如果类型为html, 则从第4步开始执行。如果是其...
  • jiangxiaoma111
  • jiangxiaoma111
  • 2014年10月04日 21:43
  • 1908

Linux 如何使用 wget 下载整个网站

Linux 如何使用 wget 下载整个网站近期要去缅甸呆半个月,想顺便把 W3SCHOOL.COM 上面的 HTML/CSS/JS/PHP 教程温习一遍。但是有一个问题,缅甸的网速很慢,我们住的酒店...
  • github_37483541
  • github_37483541
  • 2017年02月09日 20:29
  • 2968
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:用Delphi实现整个网站图片的极速下载
举报原因:
原因补充:

(最多只允许输入30个字)