Write a program for downloading images from a webpage.

What if you open a webpage and find that there are many nice pictures on it? Save one by one? Save the webpage and process it slowly? Or do I need to copy it slowly in the IE cache directory? Because I often encounter such problems, I made a program to download images on the webpage, and the code was poorly written.

Click and click Save As download program.

 

Main Window unit:

{===================================================== ===}

{=====================================================}
{By lanyus}
{QQ: 231221}
{Email: greathjw [at] 163.com}
{=====================================================}
Unit utmain;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls, extctrls, buttons, idbasecomponent, idcomponent,
Idtcpconnection, idtcpclient, idhttp, comctrls, psapi, shellapi, filectrl;

Type
Tfmmain = Class (tform)
Bitbtn1: tbitbtn;
Le1: tlabelededit;
Idhttp1: tidhttp;
Statusbar1: tstatusbar;
Le2: tlabelededit;
Speedbutton1: tspeedbutton;
Bitbtn2: tbitbtn;
Pagecontrol1: tpagecontrol;
Tabsheet1: ttabsheet;
Tabsheet2: ttabsheet;
Memo1: tmemo;
Memo2: tmemo;
Procedure bitbtn1click (Sender: tobject );
Procedure speedbutton1click (Sender: tobject );
// Procedure bitbtn2click (Sender: tobject );
Private
{Private Declarations}
Public
Piccount, downcount: integer;
Threadqty: integer;
Dnqty: integer;
{Public declarations}
End;

VaR
Fmmain: tfmmain;

Implementation

Uses utgetthread;

{$ R *. DFM}

Procedure tfmmain. bitbtn1click (Sender: tobject );
VaR
T: tgetthread;
A: tmemorystream;
Savepath: string;
Begin
Le1.text: = trim (le1.text );
Savepath: = fmmain. le2.text;
If savepath [length (savepath)] <> '/'then savepath: = savepath + '/';
If not directoryexists (savepath) then
Begin
Try
If not forcedirectories (savepath) then
Begin
Showmessage ('invalid save path ');
Exit;
End;
Except
Showmessage ('invalid save path ');
Exit;
End;
// Showmessage ('Save directory does not exist ');

End;
Piccount: = 0;
Downcount: = 0;
Memo1.clear;
T: = tgetthread. Create (false );
End;

Procedure tfmmain. speedbutton1click (Sender: tobject );
VaR
Dir: string;
Begin
If selectdirectory ('select the Save directory', '', DIR) Then le2.text: = dir;
End;

End.

{=========================================}

Download thread Unit

{=======================================}

{=======================================}
{By lanyus}
{QQ: 231221}
{Email: greathjw [at] 163.com}
{=======================================}

Unit utgetthread;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls, extctrls, buttons, idbasecomponent, idcomponent,
Idtcpconnection, idtcpclient, idhttp, wininet;

Type
Tgetthread = Class (tthread)
Private
{Private Declarations}
Protected
IDP: tidhttp;
Procedure execute; override;
Procedure getsrc (SRC: string; s: string );
Function checkurl (URL: string): string;
End;

// Function q_posstr (const findstring, sourcestring: string; startpos: integer): integer;

Implementation

Uses utmain, utdownthread;
{Important: Methods and Properties of objects in visual components can only be
Used in a method called using synchronize, for example,

Synchronize (updatecaption );

And updatecaption cocould look like,

Procedure tgetthread. updatecaption;
Begin
Form1.caption: = 'updated in a thread ';
End ;}

{Tgetthread}

Function tgetthread. checkurl (URL: string): string;
VaR
Hurl, S, S1: string;
I, A, B: integer;
Begin
If URL [1] = '.' Then
Begin
S: = copy (fmmain. le1.text, 8, length (fmmain. le1.text)-7 );
I: = pos ('/', S );
A: = pos ('/', URL );
If I> 0 then
Result: = copy (fmmain. le1.text, 1, I + 7) + copy (URL, A + 1, length (URL)-)
Else
Result: = fmmain. le1.text + '/' + copy (URL, A + 1, length (URL)-);
Exit;
End;
If URL [1] = '/' then
Begin
S: = copy (fmmain. le1.text, 8, length (fmmain. le1.text)-7 );
I: = pos ('/', S );
While I> 0 do
Begin
Delete (s, 1, I );
I: = pos ('/', S );
End;
Result: = copy (fmmain. le1.text, 1, length (fmmain. le1.text)-length (s) + copy (URL, 2, length (URL)-1 );
Exit;
End;
Try
Hurl: = uppercase (copy (URL, 1, 4 ));
If hurl <> 'http' then
Begin
S: = copy (fmmain. le1.text, 8, length (fmmain. le1.text)-7 );
I: = pos ('/', S );
If I> 0 then
Result: = copy (fmmain. le1.text, 1, I + 7) + URL
Else
Result: = fmmain. le1.text + '/' + URL;
End
Else
Result: = URL;
Except
Result: = URL;
End;

End;

Procedure tgetthread. getsrc (SRC: string; s: string );
VaR
A, B: integer;
Picurl, urltype: string;
Download: tdownloadpic;
Begin
Fmmain. threadqty: = 0;
A: = pos (SRC, S );
While a> 0 do
Begin
Delete (s, 1, A + 3 );
Trimleft (s );
B: = pos ('>', S );
If s [1] = '"' then
Begin
Delete (s, 1, 1 );
B: = pos ('"', S );
End;
If s [1] = ''' then
Begin
Delete (s, 1, 1 );
B: = pos (''', S );
End;
Picurl: = copy (s, 1, B-1 );
Picurl: = stringreplace (picurl, ''', '', [rfreplaceall]);
Picurl: = trim (stringreplace (picurl, '"','', [rfreplaceall]);
Picurl: = checkurl (picurl );
Urltype: = uppercase (stringreplace (copy (picurl, length (picurl)-3, 4), '.', '', [rfreplaceall]);
If (Pos ('gif', urltype)> 0) or (Pos ('jpg ', urltype)> 0) or (Pos ('jpeg', urltype)> 0) or
(Pos ('png ', urltype)> 0) or (Pos ('bmp', urltype)> 0) then
Begin
INC (fmmain. threadqty );
Download: = tdownloadpic. Create (fmmain. threadqty, picurl );
Fmmain. piccount: = fmmain. piccount + 1;
Fmmain. statusbar1.panels [0]. Text: = 'discover' + inttostr (fmmain. piccount) + 'images, successfully downloaded '+ inttostr (fmmain. downcount) + 'zhang ';
Application. processmessages;
End;
A: = pos (SRC, S );
End;
End;

Procedure tgetthread. Execute;
VaR
URL, S: string;
// A, B, I: integer;
Picurl, urltype: string;
Download: tdownloadpic;
Begin
Freeonterminate: = true;
URL: = fmmain. le1.text;
Fmmain. statusbar1.panels [0]. Text: = 'reading '+ URL;
Try
IDP: = tidhttp. Create (NiL );
S: = IDP. Get (URL );
Fmmain. memo2.text: = s;
Fmmain. statusbar1.panels [0]. Text: = 'webpage read successfully ';
Except
Fmmain. statusbar1.panels [0]. Text: = 'webpage reading failed ';
Fmmain. memo2.text: = '';
Exit;
End;
Fmmain. statusbar1.panels [0]. Text: = 'the image address is being analyzed. Please wait ...';
// Fmmain. memo2.text: = s;

S: = stringreplace (S, 'src', 'src', [rfreplaceall]);
Getsrc ('src = ', S );
// Getsrc ('src = ', S );

Fmmain. statusbar1.panels [0]. Text: = 'analysis completed ';
IDP. Free;
// Fmmain. memo1.lines. Add (s );
{Place thread code here}
End;

End.

{===================================================== =}