delphi idhttp 实战用法(TIdhttpEx)

以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;

function TIdCookieMgr.GetCurCookies: string;

var

strs: TStringList;

begin

strs := GetCookieList;

try

result := strs.Text;

finally

strs.Free;

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;

finally

uri.Free;

StrLst.Free;

end;

procedure TIdCookieMgr.SaveCookies(const AFileName: string);

var

StrLst: TStringList;

begin

StrLst := GetCookieList;

try

StrLst.SaveToFile(AFileName);

finally

StrLst.Free;

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.

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;

if BCheckOver then

break;

end;

finally

BMetaList.Free;

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;

function IdhttpGet(AIdhttp: TIdHTTP; AUrl: string; var AHtml: string): Boolean;

var

BStrStream: TMemoryStream;

begin

AHtml := '';

BStrStream := TMemoryStream.Create;

try

AIdhttp.Get(AUrl, BStrStream);

AHtml := GetHtmlAfterOperateIdhttp(AIdhttp, BStrStream);

Result := true;

except

on e: Exception do

begin

Result := false;

AHtml := e.Message;

end;

finally

BStrStream.Free;

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

AIdhttp.Post(AUrl, AStrList, BStrStream);

AHtml := GetHtmlAfterOperateIdhttp(AIdhttp, BStrStream);

except

on e: Exception do

begin

AHtml := e.Message;

Result := false;

end;

finally

BStrStream.Free;

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

AIdhttp.Post(AUrl, AIdMul, BStrStream);

AHtml := GetHtmlAfterOperateIdhttp(AIdhttp, BStrStream);

except

on e: Exception do

begin

AHtml := e.Message;

Result := false;

end;

finally

BStrStream.Free;

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.

uOperateIndy.pas

推荐分享