今天在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.
没有相关教程
|