Today, I saw a post on S8S8, http://www.s8s8.net/forum/index.php? Showtopic = 13495 Popularity, everyone uses different languages and scripts to download MM photos on a website, there is shell The script, C language, C , VBS, PHP, Perl, and Java and C #, it can be described as a hundred flowers, and I have written a Delphi version, I use multi-thread, basically not When I was half an hour, I took a few thousand photos, but I saw a few, all the children were not suitable. It's no wonder those SLs fight first, of course, I don't excerades :)
Program full code: // The write is relatively rough, but basically can implement the download function, can't manage so much. Unit getmm;
Interface
Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, IDBaseComponent, IDcomponent, IDtcpConnection, IDTCPCLIENT, IDTTP;
Const url = 'http://www.sergeaura.net/tgp/'; // Download the website address OFFI = 192; // directory number OFFJ = 16; // The maximum number of pictures in each directory GirlPic = 'C: / girlpic /'; // Save the local path
// thread class 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}
// Download Procedure Procedure TFORM1.BUTTON1CLICK (Sender: TOBJECT); VAR i, J: Integer; Subi, Subj, Cururl, DestPath: String; Strm: TmemoryStream; Begin Memo1.Lines.clear; // Established Directory IF Not DirectoryExists Girlpic); try strm: = tmemorystream.create; for i: = 1 to off = 1 to off offha do begin if (i <10) THEN SUBI: = '00' INTOSTR I) Else if (i> 9) and (i <100) THEN SUBI: = '0' INTOSTR (i) Else Subi: = INTOSTR (I); if (j> 9) Then Subj: = INTOSTR (J) Else Subj: = '0' INTOSTR (J); Cururl: = URL Subi '/ Images /'; Destpath: = GirlPic Subi '/'; if not Directoryexists (Destpath) THEN Forcedirectories (Destpath); // Use Thread, speed can improve n / more if checkbox1.checked the begin getmmthread (cururl, destpath, subj); Sleep (500); end else // does not use thread begin try strm.clear; IDHTTP1.GET (Cururl Subj '. JPG ', STRM); Strm.Savetofi Le (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);
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 FILEXISTS (DESTFILE) THEN BEGIN STRM.CLEAR; IDGETMM.GET (FMMURL FSUBJ '. JPG', STRM); Strm.Savetofile (DESTFILE); END; DESTFILE: = fdestPath 'TN _' fsubj '. Jpg'; if NOT FILEXISTS (DESTFILE) THEN BEGIN STRM.CLEAR; IDGETMMM.GET (Fmmurl 'TN _' FSUBJ '. JPG', STRM); Strm.SaveTofile (Destfile); end; Except end; finally strm.free; idgetmm.free; END;
Procedure TFORM1.GETMMMTHREAD (Mmurl, Destpath, Subj: string); begin rgetmm: = tgetmm.create (mmurl, destpath, subj);
End.
