吾爱破解 - 52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 4973|回复: 3
收起左侧

[其他转载] 用Delphi实现整个网站图片的极速下载

[复制链接]
yqufo 发表于 2009-5-4 14:04
//程序完整代码:
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 !\');

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

yangdashi 发表于 2009-5-29 23:11
不错,支持!!
jacken888 发表于 2011-1-4 10:47
xuxiao 发表于 2013-6-17 11:38
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则

返回列表

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2024-11-16 11:26

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表