标签：res create chrome clear ack time 分享 infopath 实战
以delphi XE8 自带indy(10.5.8.0)组件为例，分享实战中遇到的问题及解决方法。
TIdHttpEx 用法实例01[多线程获取网页](包含完整源码)
实例02(如何Post参数,如何保存与提取Cookie)待写
TIdHttpEx 已实现了对GZIP的解压,对UTF-8编码解码等
本文包含以下几个单元
uIdhttp.pas (TIdHttpEx)
uIdCookieMgr.pas (TIdCookieMgr)
uOperateIndy.pas 操作 TIdhttpEx 全靠它了
uIdhttp.Pas
复制代码
1 unit uIdHttpEx;
2
3 interface
4
5 uses
6 Classes, Idhttp, uIdCookieMgr, IdSSLOpenSSL;
7 {uIdCookieMgr 是我改进的}
8
9 type
10
11 TIdhttpEx = class(TIdhttp)
12 private
13 FIdCookieMgr: TIdCookieMgr;
14 FIdSSL: TIdSSLIOHandlerSocketOpenSSL;
15 public
16 constructor Create(AOwner: TComponent);
17 property CookieMgr: TIdCookieMgr read FIdCookieMgr;
18 procedure GenRandomUserAgent; //随便生成一个请求头,可以忽略或自己改进
19 property IdSSL: TIdSSLIOHandlerSocketOpenSSL read FIdSSL;
20
21 end;
22
23 implementation
24
25 { TIdhttpEx }
26
27 const
28
29 sUserAgent =
30 ‘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)‘;
31 // sAccept = ‘image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-shockwave-flash, application/msword, application/vnd.ms-excel, application/vnd.ms-powerpoint, */*‘;
32 sUserAgent2 =
33 ‘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)‘;
34 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
36 sUserAgent3 =
37 ‘Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/39.0.2171.65 Safari/537.36‘;
38 sAccept2 = ‘text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8‘;
39
40 MaxUserAgentCount = 3;
41
42 var
43 UserAgent: array [0 .. MaxUserAgentCount - 1] of string;
44
45 constructor TIdhttpEx.Create(AOwner: TComponent);
46 begin
47 inherited;
48
49 HTTPOptions := []; // 禁止POST参数编码，自己手动编 HttpEncodeX
50
51 // HTTPOptions := [hoNoParseMetaHTTPEquiv]; // 禁止POST参数编码，自己手动编 HttpEncodeX
52 // hoNoParseMetaHTTPEquiv 禁止解析html 此可能造成假死!
53
54 FIdCookieMgr := TIdCookieMgr.Create(self);
55 CookieManager := FIdCookieMgr;
56
57 // ssl 需要 libeay32.dll ssleay32.dll 阿里旺旺目录下可以搜索到
58
59 FIdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(self);
60 IOHandler := FIdSSL;
61
62 HandleRedirects := true;
63 AllowCookies := true;
64 ProtocolVersion := pv1_1;
65
66 Request.RawHeaders.FoldLength := 25000; // 参数头长度，重要
67
68 ReadTimeout := 15000;
69 ConnectTimeout := 15000;
70
71 RedirectMaximum := 5;
72 Request.UserAgent := sUserAgent3;
73 Request.Accept := sAccept;
74 Request.AcceptEncoding := ‘gzip‘;
75
76 end;
77
78 procedure TIdhttpEx.GenRandomUserAgent;
79 begin
80 Randomize;
81 self.Request.UserAgent := UserAgent[Random(MaxUserAgentCount)];
82 end;
83
84 initialization
85
86 UserAgent[0] :=
87 ‘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)‘;
88 UserAgent[1] :=
89 ‘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)‘;
90 UserAgent[2] :=
91 ‘Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/39.0.2171.65 Safari/537.36‘;
92
93 // 这三句请忽略，有些网站认求头，我随便写的。请大家根本实际情况改进
94 finalization
95
96 end.
复制代码
uIdCookieMgr.Pas
复制代码
1 unit uIdCookieMgr;
2
3 interface
4
5 uses
6 IdCookieManager, Classes;
7
8 type
9 TIdCookieMgr = class(TIdCookieManager)
10 private
11
12 procedure SetCurCookies(const Value: string);
13
14 function GetCurCookies: string;
15 function GetCookieList: TStringList;
16
17 public
18
19 procedure SaveCookies(const AFileName: string);
20 procedure LoadCookies(const AFileName: string);
21
22 function GetCookieValue(const ACookieName: string): string;
23 property CurCookies: string read GetCurCookies write SetCurCookies;
24
25 end;
26
27 implementation
28
29 uses
30 IdCookie, SysUtils, IdURI, uStrUtils, IdGlobalProtocols, DateUtils;
31 { uStrUtils 一套操作字串的函数单元 }
32
33 function TIdCookieMgr.GetCookieList: TStringList;
34 var
35 C: Tcollectionitem;
36 begin
37 result := TStringList.Create;
38 for C in CookieCollection do
39 result.add((C as TIdCookie).CookieText);
40 end;
41
42 function TIdCookieMgr.GetCookieValue(const ACookieName: string): string;
43 var
44 n: integer;
45 begin
46 result := ‘‘;
47 if IsNotEmptyStr(ACookieName) then
48 begin
49 n := CookieCollection.GetCookieIndex(ACookieName);
50 if n >= 0 then
51 result := CookieCollection.Cookies[n].Value;
52 end;
53 end;
54
55 function TIdCookieMgr.GetCurCookies: string;
56 var
57 strs: TStringList;
58 begin
59 strs := GetCookieList;
60 try
61 result := strs.Text;
62 finally
63 strs.Free;
64 end;
65 end;
66
67 procedure TIdCookieMgr.LoadCookies(const AFileName: string);
68 var
69 StrLst: TStringList;
70 C: TIdCookie;
71 uri: TIdURI;
72 s, t: string;
73 begin
74 StrLst := TStringList.Create;
75 uri := TIdURI.Create;
76 try
77 if FileExists(AFileName) then
78 begin
79 StrLst.LoadFromFile(AFileName);
80 for s in StrLst do
81 begin
82 C := CookieCollection.add;
83 CookieCollection.AddCookie(C, uri);
84 C.ParseServerCookie(s, uri);
85 C.Domain := GetStrBetween(s, ‘Domain=‘, ‘;‘);
86 C.Path := GetStrBetween(s, ‘Path=‘, ‘;‘);
87 t := GetStrBetween(s, ‘Expires=‘, ‘GMT‘) + ‘GMT‘; // GetStrBetween 在 uStrUtils 单元中
88 C.Expires := CookieStrToLocalDateTime(t);
89 end;
90 end;
91 finally
92 uri.Free;
93 StrLst.Free;
94 end;
95 end;
96
97 procedure TIdCookieMgr.SaveCookies(const AFileName: string);
98 var
99 StrLst: TStringList;
100 begin
101 StrLst := GetCookieList;
102 try
103 StrLst.SaveToFile(AFileName);
104 finally
105 StrLst.Free;
106 end;
107 end;
108
109 procedure TIdCookieMgr.SetCurCookies(const Value: string);
110 var
111 StrLst: TStringList;
112 C: TIdCookie;
113 uri: TIdURI;
114 s, t: string;
115 begin
116 StrLst := TStringList.Create;
117 uri := TIdURI.Create;
118 try
119 StrLst.Text := Value;
120 CookieCollection.Clear;
121 for s in StrLst do
122 begin
123 C := CookieCollection.add;
124 CookieCollection.AddCookie(C, uri);
125 C.ParseServerCookie(s, uri);
126 C.Domain := GetStrBetween(s, ‘Domain=‘, ‘;‘);
127 C.Path := GetStrBetween(s, ‘Path=‘, ‘;‘);
128 t := GetStrBetween(s, ‘Expires=‘, ‘GMT‘) + ‘GMT‘;
129 C.Expires := CookieStrToLocalDateTime(t);
130 end;
131 finally
132 uri.Free;
133 StrLst.Free;
134 end;
135 end;
136
137 end.
复制代码
uOperateIndy.pas 非常有用操作 TIdhttpEx 全靠它了
复制代码
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;
11 function IdhttpPost(AIdhttp: TIdHTTP; AIdMul: TIdMultiPartFormDataStream; AUrl: string;
12 var AHtml: string): Boolean; overload;
13
14 function GetHtmlFromUrl(AUrl: string; var AHtml: string): Boolean;
15
16 implementation
17
18 uses
19 uIdhttpEx, SysUtils, ZLibEx, StrUtils, uStrUtils, uHtmlElement, uParseHtml;
20 { 带u的单元，都是我写的,ZLibEx 是解压库 }
21
22 //解压GZIP 那个参数31是试出来的
23 procedure DecompressGZIP(inStream, outStream: TStream); inline;
24 begin
25 ZDecompressStream2(inStream, outStream, 31);
26 end;
27
28 function HtmlIsUTF8(AHtml: string): Boolean;
29 var
30 BMetaList: TSingleHtmlElementList;
31 BMeta: TSingleHtmlElement;
32 BKeyElement: PKeyElement;
33 BCheckOver: Boolean;
34 sKeyName: string;
35 sKeyValue: string;
36 begin
37 Result := false;
38 BMetaList := TSingleHtmlElementList.Create;
39 try
40
41 GetMetaList(AHtml, BMetaList);
42
43 BCheckOver := false;
44
45 for BMeta in BMetaList do
46 begin
47
48 for BKeyElement in BMeta.KeyElementList do
49 begin
50
51 sKeyName := UpperCase(BKeyElement.Name);
52 sKeyValue := UpperCase(BKeyElement.Value);
53
54 if PosEx(‘UTF-8‘, sKeyValue) > 0 then
55 begin
56 Result := true;
57 BCheckOver := true;
58 break;
59 end;
60
61 end;
62
63 if BCheckOver then
64 break;
65 end;
66
67 finally
68 BMetaList.Free;
69 end;
70 end;
71
72 function GetHtmlAfterOperateIdhttp(AIdhttp: TIdHTTP; AStream: TStream): string;
73 var
74 BSize: Int64;
75 BOutStream: TMemoryStream;
76 TempStream: TMemoryStream;
77 rS: RawByteString;
78 s: string;
79 sUtf8: string;
80 BIsUtf8: Boolean;
81 sCharSet: string;
82
83 begin
84 BSize := AStream.Size;
85
86 BOutStream := TMemoryStream.Create;
87 try
88 if BSize > 0 then
89 begin
90
91 if PosEx(‘GZIP‘, UpperCase(AIdhttp.Response.ContentEncoding)) > 0 then
92 begin
93 AStream.Position := 0;
94 DecompressGZIP(AStream, BOutStream);
95 TempStream := BOutStream;
96 end
97 else
98 TempStream := TMemoryStream(AStream);
99
100 BSize := TempStream.Size;
101 SetLength(rS, BSize);
102 TempStream.Position := 0;
103 TempStream.ReadBuffer(rS[1], BSize);
104
105 s := string(rS);
106 sUtf8 := UTF8ToString(rS);
107
108 sCharSet := AIdhttp.Response.CharSet;
109 BIsUtf8 := PosEx(‘UTF-8‘, UpperCase(sCharSet)) > 0;
110 if not BIsUtf8 then
111 BIsUtf8 := HtmlIsUTF8(s);
112
113 if BIsUtf8 then
114 Result := sUtf8
115 else
116 begin
117
118 if (PosEx(‘的‘, sUtf8) > 0) or (PosEx(‘地‘, sUtf8) > 0) or (PosEx(‘为‘, sUtf8) > 0) or
119 (PosEx(‘于‘, sUtf8) > 0) or (PosEx(‘我们‘, sUtf8) > 0) or (PosEx(‘电‘, sUtf8) > 0) or
120 (PosEx(‘邮‘, sUtf8) > 0) then
121
122 begin
123 Result := sUtf8;
124 end
125 else
126 Result := s;
127
128 end;
129
130 end
131 finally
132 BOutStream.Free;
133 end;
134
135 end;
136
137 function IdhttpGet(AIdhttp: TIdHTTP; AUrl: string; var AHtml: string): Boolean;
138 var
139 BStrStream: TMemoryStream;
140 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
150 begin
151 Result := false;
152 AHtml := e.Message;
153 end;
154 end;
155 finally
156 BStrStream.Free;
157 end;
158 end;
159
160 function IdhttpPost(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
170 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
180 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;
190 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;
200 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
210 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
220 end.
复制代码
附：delphi 进阶基础技能说明
http://www.cnblogs.com/lackey/p/4085131.html
标签：res create chrome clear ack time 分享 infopath 实战
原文地址：http://www.cnblogs.com/findumars/p/7019722.html
