码迷，mamicode.com
首页 > Windows程序 > 详细

delphi idhttp 实战用法(TIdhttpEx)

时间：2016-07-07 00:59:11      阅读：867      评论：0      收藏：0      [点我收藏+]

标签：

以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

 

delphi idhttp 实战用法(TIdhttpEx)

标签：

原文地址：http://www.cnblogs.com/findumars/p/5648530.html
踩
(0)
赞
(0)
   
举报
评论 一句话评论（0）
登录后才能评论！
分享档案
更多>
2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)
周排行
mamicode.com排行更多图片
更多
友情链接
兰亭集智   国之画   百度统计   站长统计   阿里云   chrome插件   新版天听网
关于我们 - 联系我们 - 留言反馈
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码！