以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
unit uIdHttpEx; interface uses Classes, Idhttp, uIdCookieMgr, IdSSLOpenSSL; {uIdCookieMgr 是我改进的} type TIdhttpEx = class(TIdhttp) private FIdCookieMgr: TIdCookieMgr; FIdSSL: TIdSSLIOHandlerSocketOpenSSL; public constructor Create(AOwner: TComponent); property CookieMgr: TIdCookieMgr read FIdCookieMgr; procedure GenRandomUserAgent; //随便生成一个请求头,可以忽略或自己改进 property IdSSL: TIdSSLIOHandlerSocketOpenSSL read FIdSSL; end; implementation { TIdhttpEx } const 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, */*'; sUserAgent3 = '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'; MaxUserAgentCount = 3; var UserAgent: array [0 .. MaxUserAgentCount - 1] of string; constructor TIdhttpEx.Create(AOwner: TComponent); begin inherited; HTTPOptions := []; // 禁止POST参数编码,自己手动编 HttpEncodeX // HTTPOptions := [hoNoParseMetaHTTPEquiv]; // 禁止POST参数编码,自己手动编 HttpEncodeX // hoNoParseMetaHTTPEquiv 禁止解析html 此可能造成假死! FIdCookieMgr := TIdCookieMgr.Create(self); CookieManager := FIdCookieMgr; // ssl 需要 libeay32.dll ssleay32.dll 阿里旺旺目录下可以搜索到 FIdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(self); IOHandler := FIdSSL; HandleRedirects := true; AllowCookies := true; ProtocolVersion := pv1_1; Request.RawHeaders.FoldLength := 25000; // 参数头长度,重要 ReadTimeout := 15000; ConnectTimeout := 15000; RedirectMaximum := 5; Request.UserAgent := sUserAgent3; Request.Accept := sAccept; Request.AcceptEncoding := 'gzip'; end; procedure TIdhttpEx.GenRandomUserAgent; begin Randomize; self.Request.UserAgent := UserAgent[Random(MaxUserAgentCount)]; end; initialization 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'; // 这三句请忽略,有些网站认求头,我随便写的。请大家根本实际情况改进 finalization end. uIdhttpEx.pas
uIdCookieMgr.Pas
unit uIdCookieMgr; interface uses IdCookieManager, Classes; type TIdCookieMgr = class(TIdCookieManager) private procedure SetCurCookies(const Value: string); function GetCurCookies: string; function GetCookieList: TStringList; public procedure SaveCookies(const AFileName: string); procedure LoadCookies(const AFileName: string); function GetCookieValue(const ACookieName: string): string; property CurCookies: string read GetCurCookies write SetCurCookies; end; implementation uses IdCookie, SysUtils, IdURI, uStrUtils, IdGlobalProtocols, DateUtils; { uStrUtils 一套操作字串的函数单元 } function TIdCookieMgr.GetCookieList: TStringList; var C: Tcollectionitem; begin result := TStringList.Create; for C in CookieCollection do result.add((C as TIdCookie).CookieText); end; function TIdCookieMgr.GetCookieValue(const ACookieName: string): string; var n: integer; begin result := ''; if IsNotEmptyStr(ACookieName) then begin n := CookieCollection.GetCookieIndex(ACookieName); if n >= 0 then result := CookieCollection.Cookies[n].Value; end; end; function TIdCookieMgr.GetCurCookies: string; var strs: TStringList; begin strs := GetCookieList; try result := strs.Text; finally strs.Free; end; end; procedure TIdCookieMgr.LoadCookies(const AFileName: string); var StrLst: TStringList; C: TIdCookie; uri: TIdURI; s, t: string; begin StrLst := TStringList.Create; uri := TIdURI.Create; try if FileExists(AFileName) then begin StrLst.LoadFromFile(AFileName); for s in StrLst do begin C := CookieCollection.add; 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 在 uStrUtils 单元中 C.Expires := CookieStrToLocalDateTime(t); end; end; finally uri.Free; StrLst.Free; end; end; procedure TIdCookieMgr.SaveCookies(const AFileName: string); var StrLst: TStringList; begin StrLst := GetCookieList; try StrLst.SaveToFile(AFileName); finally StrLst.Free; end; end; procedure TIdCookieMgr.SetCurCookies(const Value: string); var StrLst: TStringList; C: TIdCookie; uri: TIdURI; s, t: string; begin StrLst := TStringList.Create; uri := TIdURI.Create; try StrLst.Text := Value; CookieCollection.Clear; for s in StrLst do begin C := CookieCollection.add; CookieCollection.AddCookie(C, uri); C.ParseServerCookie(s, uri); C.Domain := GetStrBetween(s, 'Domain=', ';'); C.Path := GetStrBetween(s, 'Path=', ';'); t := GetStrBetween(s, 'Expires=', 'GMT') + 'GMT'; C.Expires := CookieStrToLocalDateTime(t); end; finally uri.Free; StrLst.Free; end; end; end. uIdCookeMgr.pas
uOperateIndy.pas 非常有用操作 TIdhttpEx 全靠它了
unit uOperateIndy; interface uses Classes, Idhttp, IdMultipartFormData; function IdhttpGet(AIdhttp: TIdHTTP; AUrl: string; var AHtml: string): Boolean; function IdhttpPost(AIdhttp: TIdHTTP; AStrList: TStringList; AUrl: string; var AHtml: String) : Boolean; overload; function IdhttpPost(AIdhttp: TIdHTTP; AIdMul: TIdMultiPartFormDataStream; AUrl: string; var AHtml: string): Boolean; overload; function GetHtmlFromUrl(AUrl: string; var AHtml: string): Boolean; implementation uses uIdhttpEx, SysUtils, ZLibEx, StrUtils, uStrUtils, uHtmlElement, uParseHtml; { 带u的单元,都是我写的,ZLibEx 是解压库 } //解压GZIP 那个参数31是试出来的 procedure DecompressGZIP(inStream, outStream: TStream); inline; begin ZDecompressStream2(inStream, outStream, 31); end; function HtmlIsUTF8(AHtml: string): Boolean; var BMetaList: TSingleHtmlElementList; BMeta: TSingleHtmlElement; BKeyElement: PKeyElement; BCheckOver: Boolean; sKeyName: string; sKeyValue: string; begin Result := false; BMetaList := TSingleHtmlElementList.Create; try GetMetaList(AHtml, BMetaList); BCheckOver := false; for BMeta in BMetaList do begin for BKeyElement in BMeta.KeyElementList do begin sKeyName := UpperCase(BKeyElement.Name); sKeyValue := UpperCase(BKeyElement.Value); if PosEx('UTF-8', sKeyValue) > 0 then begin Result := true; BCheckOver := true; break; end; end; if BCheckOver then break; end; finally BMetaList.Free; end; end; function GetHtmlAfterOperateIdhttp(AIdhttp: TIdHTTP; AStream: TStream): string; var BSize: Int64; BOutStream: TMemoryStream; TempStream: TMemoryStream; rS: RawByteString; s: string; sUtf8: string; BIsUtf8: Boolean; sCharSet: string; begin BSize := AStream.Size; BOutStream := TMemoryStream.Create; try if BSize > 0 then begin if PosEx('GZIP', UpperCase(AIdhttp.Response.ContentEncoding)) > 0 then begin AStream.Position := 0; DecompressGZIP(AStream, BOutStream); TempStream := BOutStream; end else TempStream := TMemoryStream(AStream); BSize := TempStream.Size; SetLength(rS, BSize); TempStream.Position := 0; TempStream.ReadBuffer(rS[1], BSize); s := string(rS); sUtf8 := UTF8ToString(rS); sCharSet := AIdhttp.Response.CharSet; BIsUtf8 := PosEx('UTF-8', UpperCase(sCharSet)) > 0; if not BIsUtf8 then BIsUtf8 := HtmlIsUTF8(s); if BIsUtf8 then Result := sUtf8 else begin if (PosEx('的', sUtf8) > 0) or (PosEx('地', sUtf8) > 0) or (PosEx('为', sUtf8) > 0) or (PosEx('于', sUtf8) > 0) or (PosEx('我们', sUtf8) > 0) or (PosEx('电', sUtf8) > 0) or (PosEx('邮', sUtf8) > 0) then begin Result := sUtf8; end else Result := s; end; end finally BOutStream.Free; end; end; function IdhttpGet(AIdhttp: TIdHTTP; AUrl: string; var AHtml: string): Boolean; var BStrStream: TMemoryStream; begin AHtml := ''; BStrStream := TMemoryStream.Create; try try AIdhttp.Get(AUrl, BStrStream); AHtml := GetHtmlAfterOperateIdhttp(AIdhttp, BStrStream); Result := true; except on e: Exception do begin Result := false; AHtml := e.Message; end; end; finally BStrStream.Free; end; end; function IdhttpPost(AIdhttp: TIdHTTP; AStrList: TStringList; AUrl: string; var AHtml: String) : Boolean; overload; var BStrStream: TMemoryStream; begin Result := true; AHtml := ''; BStrStream := TMemoryStream.Create; try try AIdhttp.Post(AUrl, AStrList, BStrStream); AHtml := GetHtmlAfterOperateIdhttp(AIdhttp, BStrStream); except on e: Exception do begin AHtml := e.Message; Result := false; end; end; finally BStrStream.Free; end; end; function IdhttpPost(AIdhttp: TIdHTTP; AIdMul: TIdMultiPartFormDataStream; AUrl: string; var AHtml: string): Boolean; overload; var BStrStream: TMemoryStream; begin Result := true; AHtml := ''; BStrStream := TMemoryStream.Create; try try AIdhttp.Post(AUrl, AIdMul, BStrStream); AHtml := GetHtmlAfterOperateIdhttp(AIdhttp, BStrStream); except on e: Exception do begin AHtml := e.Message; Result := false; end; end; finally BStrStream.Free; end; end; function GetHtmlFromUrl(AUrl: string; var AHtml: string): Boolean; var Idhttp: TIdhttpEx; begin Idhttp := TIdhttpEx.Create(nil); try Result := IdhttpGet(Idhttp, AUrl, AHtml); finally Idhttp.Free; end; end; end. uOperateIndy.pas
http://www.cnblogs.com/lackey/p/4085131.html