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

var

  UserAgent: array [ .. MaxUserAgentCount - ] 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_;

  Request.RawHeaders.FoldLength := ; // 参数头长度，重要

  ReadTimeout := ;

  ConnectTimeout := ;

  RedirectMaximum := ;

  Request.UserAgent := sUserAgent3;

  Request.Accept := sAccept;

  Request.AcceptEncoding := 'gzip';

end;

procedure TIdhttpEx.GenRandomUserAgent;

begin

  Randomize;

  self.Request.UserAgent := UserAgent[Random(MaxUserAgentCount)];

end;

initialization

UserAgent[] :=

  '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[] :=

  '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[] :=

  '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 >=  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, );

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) >  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 >  then

    begin

      if PosEx('GZIP', UpperCase(AIdhttp.Response.ContentEncoding)) >  then

      begin

        AStream.Position := ;

        DecompressGZIP(AStream, BOutStream);

        TempStream := BOutStream;

      end

      else

        TempStream := TMemoryStream(AStream);

      BSize := TempStream.Size;

      SetLength(rS, BSize);

      TempStream.Position := ;

      TempStream.ReadBuffer(rS[], BSize);

      s := string(rS);

      sUtf8 := UTF8ToString(rS);

      sCharSet := AIdhttp.Response.CharSet;

      BIsUtf8 := PosEx('UTF-8', UpperCase(sCharSet)) > ;

      if not BIsUtf8 then

        BIsUtf8 := HtmlIsUTF8(s);

      if BIsUtf8 then

        Result := sUtf8

      else

      begin

        if (PosEx('的', sUtf8) > ) or (PosEx('地', sUtf8) > ) or (PosEx('为', sUtf8) > ) or

          (PosEx('于', sUtf8) > ) or (PosEx('我们', sUtf8) > ) or (PosEx('电', sUtf8) > ) or

          (PosEx('邮', sUtf8) > ) 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