Delphi Idhttp Combat Usage (TIDHTTPEX)

Take Delphi XE8 self-contained Indy (10.5.8.0) as an example to share the problems encountered in the actual combat and solutions.

Tidhttpex Usage Instance 01[multithreading get Web page] (full source included)

Example 02 (how post parameters, how to save and extract cookies) to write

Tidhttpex has implemented the decompression of gzip, encoding and decoding of UTF-8, etc.

This article contains the following units

Uidhttp.pas (Tidhttpex)

Uidcookiemgr.pas (Tidcookiemgr)

Uoperateindy.pas operation Tidhttpex It all depends on it.

Uidhttp.pas

Copy Code
1 unit Uidhttpex;
2
3 interface
4
5 uses
6 Classes, Idhttp, Uidcookiemgr, Idsslopenssl;
7 {Uidcookiemgr is my improvement}
8
9 type
10
Tidhttpex = Class (Tidhttp)
Private
Fidcookiemgr:tidcookiemgr;
Fidssl:tidssliohandlersocketopenssl;
Public
Constructor Create (aowner:tcomponent);
Cookiemgr:tidcookiemgr read fidcookiemgr;
Procedure Genrandomuseragent; Randomly generate a request header that you can ignore or improve yourself
Idssl:tidssliohandlersocketopenssl read Fidssl;
20
The end;
22
Implementation
24
{Tidhttpex}
26
Const
28
Suseragent =
mozilla/4.0 ' (compatible; MSIE 7.0; Windows NT 5.1; trident/4.0; mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1);. NET CLR 2.0.50727) ';
//saccept = ' image/gif, Image/jpeg, Image/pjpeg, Image/pjpeg, Application/x-shockwave-flash, Application/msword, Application/vnd.ms-excel, Application/vnd.ms-powerpoint, */* ';
SUserAgent2 =
"Mozilla/4.0" (compatible; MSIE 8.0; Windows NT 5.1; trident/4.0; infopath.3;. NET CLR 2.0.50727;. NET CLR 3.0.4506.2152;. NET CLR 3.5.30729) ';
saccept = ' Application/x-shockwave-flash, image/gif, Image/jpeg, Image/pjpeg, Application/msword, application/ Vnd.ms-excel, Application/vnd.ms-powerpoint, Application/x-ms-application, APPLICATION/X-MS-XBAP, application/ Vnd.ms-xpsdocument, Application/xaml+xml, */* ';
35
Approx. SUserAgent3 =
PNs ' mozilla/5.0 (Windows NT 5.1) applewebkit/537.36 (khtml, like Gecko) chrome/39.0.2171.65 safari/537.36 ';
SAccept2 = ' text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8 ';
39
Maxuseragentcount = 3;
41
var
Useragent:array [0.. MaxUserAgentCount-1] of string;
44
Constructor Tidhttpex.create (aowner:tcomponent);
Begin
inherited;
48
Httpoptions: = []; Disable post parameter encoding, manual Httpencodex
50
Wuyi//Httpoptions: = [HONOPARSEMETAHTTPEQUIV]; Disable post parameter encoding, manual Httpencodex
Block//HONOPARSEMETAHTTPEQUIV parsing HTML This can cause suspended animation!
53
Fidcookiemgr: = Tidcookiemgr.create (self);
Cookiemanager: = Fidcookiemgr;
56
//SSL Required Libeay32.dll ssleay32.dll alibaba directory can be searched
58
Fidssl: = Tidssliohandlersocketopenssl.create (self);
Iohandler: = Fidssl;
61
Handleredirects: = true;
AllowCookies: = true;
ProtocolVersion: = pv1_1;
65
Request.RawHeaders.FoldLength: = 25000; Parameter head length, important
67
ReadTimeout: = 15000;
ConnectTimeout: = 15000;
70
Redirectmaximum: = 5;
Request.useragent: = SUserAgent3;
Request.accept: = saccept;
Request.acceptencoding: = ' gzip ';
75
The end;
77
Procedure Tidhttpex.genrandomuseragent;
The Begin
Randomize;
Bayi Self. Request.useragent: = Useragent[random (Maxuseragentcount)];
The end;
83
Initialization
85
Useragent[0]: =
"Mozilla/4.0" (compatible; MSIE 7.0; Windows NT 5.1; trident/4.0; mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1);. NET CLR 2.0.50727) ';
USERAGENT[1]: =
"Mozilla/4.0" (compatible; MSIE 8.0; Windows NT 5.1; trident/4.0; infopath.3;. NET CLR 2.0.50727;. NET CLR 3.0.4506.2152;. NET CLR 3.5.30729) ';
USERAGENT[2]: =
mozilla/5.0 (Windows NT 5.1) applewebkit/537.36 (khtml, like Gecko) chrome/39.0.2171.65 safari/537.36 ';
92
93//These three sentences please ignore, some website to seek the head, I casually write. Please let us have a real improvement
94 Finalization
95
The end.
Copy Code
Uidcookiemgr.pas

Copy Code
1 unit uidcookiemgr;
2
3 interface
4
5 uses
6 Idcookiemanager, Classes;
7
8 Type
9 Tidcookiemgr = Class (Tidcookiemanager)
Private
11
Procedure Setcurcookies (const value:string);
13
function getcurcookies:string;
function getcookielist:tstringlist;
16
Public
18
Procedure Savecookies (const afilename:string);
Procedure Loadcookies (const afilename:string);
21st
function Getcookievalue (const acookiename:string): string;
Curcookies:string read Getcurcookies write setcurcookies;
24
The end;
26
Implementation
28
Uses
Idcookie, Sysutils, Iduri, Ustrutils, Idglobalprotocols, dateutils;
{Ustrutils A set of function units for manipulating strings}
32
TIdCookieMgr.GetCookieList:TStringList function;
var
C:tcollectionitem;
The Begin
PNS Result: = Tstringlist.create;
Cookiecollection C in
Result.add (C as Tidcookie). Cookietext);
The end;
41
Tidcookiemgr.getcookievalue function (const acookiename:string): string;
var
N:integer;
Begin
Result: = ';
If Isnotemptystr (acookiename) Then
Begin
N: = Cookiecollection.getcookieindex (Acookiename);
If n >= 0 Then
Wuyi Result: = Cookiecollection.cookies[n]. Value;
The end;
The end;
54
TIdCookieMgr.GetCurCookies:string function;
$ var
Strs:tstringlist;
The "Begin"
STRs: = getcookielist;
Try
The result: = STRs. Text;
Finally
STRs. Free;
The end;
The end;
66
Procedure Tidcookiemgr.loadcookies (const afilename:string);
$ var
Strlst:tstringlist;
C:tidcookie;
Uri:tiduri;
S, t:string;
The Begin
Strlst: = tstringlist.create;
The URI: = tiduri.create;
Try
If FileExists (afilename) Then
Begin
Strlst.loadfromfile (Afilename);
For s in Strlst do
Bayi begin
Cookiecollection.add C: =;
Cookiecollection.addcookie (C, URI);
C.parseservercookie (S, URI);
C.domain: = Getstrbetween (S, ' domain= ', '; ');
C.path: = Getstrbetween (S, ' path= ', '; ');
T: = Getstrbetween (S, ' expires= ', ' GMT ') + ' GMT '; Getstrbetween in the Ustrutils unit
C.expires: = Cookiestrtolocaldatetime (t);
The end;
The end;
The finally
The URI. Free;
Strlst.free;
94 End;
The end;
96
Procedure Tidcookiemgr.savecookies (const afilename:string);
98 Var
Strlst:tstringlist;
Begin
101 Strlst: = getcookielist;
102 Try
103 Strlst.savetofile (Afilename);
104 finally
Strlst.free;
106 End;
107 end;
108
109 Procedure tidcookiemgr.setcurcookies (const value:string);
var
111 strlst:tstringlist;
C:tidcookie;
113 Uri:tiduri;
S, t:string;
+ Begin
Strlst: = tstringlist.create;
117 URI: = tiduri.create;
118 Try
119 Strlst.text: = Value;
Cookiecollection.clear;
121 for S in Strlst do
122 begin
123 C: = Cookiecollection.add;
124 Cookiecollection.addcookie (C, URI);
C.parseservercookie (S, URI);
126 C.domain: = Getstrbetween (S, ' domain= ', '; ');
127 C.path: = Getstrbetween (S, ' path= ', '; ');
T: = Getstrbetween (S, ' expires= ', ' GMT ') + ' GMT ';
129 C.expires: = Cookiestrtolocaldatetime (t);
The end;
131 finally
The URI. Free;
133 Strlst.free;
134 End;
135 end;
136
137 end.
Copy Code
Uoperateindy.pas very useful operation Tidhttpex it all depends on it.

Copy Code
1 unit Uoperateindy;
2
3 interface
4
5 uses
6 Classes, Idhttp, Idmultipartformdata;
7
8 function Idhttpget (aidhttp:tidhttp; aurl:string; var ahtml:string): Boolean;
9 function idhttppost (aidhttp:tidhttp; Astrlist:tstringlist; aurl:string; var ahtml:string)
10:boolean; overload;
One function idhttppost (aidhttp:tidhttp; Aidmul:tidmultipartformdatastream; aurl:string;
var ahtml:string): Boolean; overload;
13
Gethtmlfromurl function (aurl:string; var ahtml:string): Boolean;
15
Implementation
17
Uses
Uidhttpex, Sysutils, Zlibex, Strutils, Ustrutils, Uhtmlelement, uparsehtml;
20 {Unit with u, I wrote, Zlibex is Engross}
21st
22//Unzip gzip that parameter 31 was tried out.
Procedure Decompressgzip (instream, Outstream:tstream); Inline
Begin
ZDecompressStream2 (Instream, OutStream, 31);
The end;
27
HtmlIsUTF8 function (ahtml:string): Boolean;
var
Bmetalist:tsinglehtmlelementlist;
Bmeta:tsinglehtmlelement;
Bkeyelement:pkeyelement;
Bcheckover:boolean;
skeyname:string;
skeyvalue:string;
The Begin
PNS Result: = false;
Bmetalist: = tsinglehtmlelementlist.create;
Try
40
Getmetalist (AHtml, bmetalist);
42
Bcheckover: = false;
44
Bmeta in Bmetalist do
Begin
47
Bkeyelement in Bmeta.keyelementlist do
The Begin
50
Wuyi sKeyName: = uppercase (Bkeyelement.name);
Skeyvalue: = uppercase (Bkeyelement.value);
53
If Posex (' UTF-8 ', Skeyvalue) > 0 Then
Begin
The Result: = true;
Bcheckover: = true;
break;
The end;
60
The end;
62
If Bcheckover Then
break;
The end;
66
Finally
Bmetalist.free;
The end;
The end;
71
gethtmlafteroperateidhttp function (aidhttp:tidhttp; Astream:tstream): string;
var
Bsize:int64;
Boutstream:tmemorystream;
Tempstream:tmemorystream;
rs:rawbytestring;
s:string;
sutf8:string;
Bisutf8:boolean;
Bayi scharset:string;
82
The "Begin"
Bsize: = astream.size;
85
Boutstream: = tmemorystream.create;
Try
If bsize > 0 Then
The Begin
90
If Posex (' GZIP ', uppercase (AIdhttp.Response.ContentEncoding)) > 0 Then
The Begin
Astream.position: = 0;
94 Decompressgzip (Astream, Boutstream);
Tempstream: = Boutstream;
End
$ else
98 Tempstream: = Tmemorystream (Astream);
99
Bsize: = tempstream.size;
101 SetLength (RS, bsize);
102 Tempstream.position: = 0;
103 Tempstream.readbuffer (Rs[1], bsize);
104
S: = string (RS);
106 SUtf8: = Utf8tostring (RS);
107
108 Scharset: = AIdhttp.Response.CharSet;
109 BIsUtf8: = Posex (' UTF-8 ', uppercase (Scharset)) > 0;
If not BIsUtf8 then
111 BIsUtf8: = HtmlIsUTF8 (s);
112
113 If BIsUtf8 Then
The Result: = SUtf8
+ Else
The Begin
117
118 if (Posex (' ', SUtf8) > 0) or (posex (' ground ', SUtf8) > 0) or (posex (' for ', SUtf8) > 0) or
119 (Posex (' in ', SUtf8) > 0) or (posex (' we ', SUtf8) > 0) or (posex (' electricity ', SUtf8) > 0) or
(Posex (' Mail ', SUtf8) > 0) Then
121
122 begin
123 Result: = SUtf8;
124 End
"Else"
126 Result: = S;
127
The end;
129
The end
131 finally
Boutstream.free;
133 End;
134
135 end;
136
137 function Idhttpget (aidhttp:tidhttp; aurl:string; var ahtml:string): Boolean;
138 Var
139 Bstrstream:tmemorystream;
Begin
141 AHtml: = ";
142 Bstrstream: = Tmemorystream.create;
143 Try
144 Try
145 Aidhttp.get (Aurl, Bstrstream);
146 AHtml: = Gethtmlafteroperateidhttp (Aidhttp, Bstrstream);
147 Result: = true;
148 except
149 on E:exception do
Begin
151 Result: = false;
AHtml: = E.message;
153 end;
154 end;
155 finally
156 Bstrstream.free;
157 end;
158 end;
159
Idhttppost function (aidhttp:tidhttp; Astrlist:tstringlist; aurl:string; var ahtml:string)
161:boolean; overload;
162 Var
163 Bstrstream:tmemorystream;
164 begin
165 Result: = true;
166 AHtml: = ";
167 Bstrstream: = Tmemorystream.create;
168 try
169 Try
Aidhttp.post (Aurl, Astrlist, Bstrstream);
171 AHtml: = Gethtmlafteroperateidhttp (Aidhttp, Bstrstream);
172 except
173 on E:exception do
174 begin
175 AHtml: = E.message;
176 Result: = false;
177 end;
178 end;
179 finally
Bstrstream.free;
181 end;
182 end;
183
184 function Idhttppost (aidhttp:tidhttp; Aidmul:tidmultipartformdatastream; aurl:string;
185 var ahtml:string): Boolean; overload;
186 Var
187 Bstrstream:tmemorystream;
188 begin
189 Result: = true;
AHtml: = ";
191 Bstrstream: = Tmemorystream.create;
192 try
193 try
194 aidhttp.post (Aurl, Aidmul, Bstrstream);
195 AHtml: = Gethtmlafteroperateidhttp (Aidhttp, Bstrstream);
196 except
197 on E:exception do
198 begin
199 AHtml: = E.message;
The Result: = false;
201 End;
202 end;
203 finally
204 Bstrstream.free;
205 End;
206 End;
207
208 function Gethtmlfromurl (aurl:string; var ahtml:string): Boolean;
209 Var
Idhttp:tidhttpex;
211 Begin
212 Idhttp: = tidhttpex.create (nil);
213 try
214 Result: = Idhttpget (Idhttp, Aurl, AHtml);
215 finally
216 Idhttp.free;
217 end;
218 End;
219
The end.
Copy Code
Attached: Delphi Advanced Basic Skills Description

Http://www.cnblogs.com/lackey/p/4085131.html

Delphi Idhttp Combat Usage (TIDHTTPEX)