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.

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.

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.

附：delphi 进阶基础技能说明