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

时间： 2024-10-25 10:12:26

delphi idhttp 实战用法(TIdhttpEx)的相关文章

delphi idhttp 实战用法

以delphi xe2 自带indy(10.5.8.0)组件为例,分享实战中遇到的问题及解决方法. Idhttp 重要属性 HTTPOptions := []; 属性设为空,禁止idhttp自动为post的TStringList参数编码,因为自动编码使用的是HttpApp单元下的HttpEncode, 但此函数有误,未将+,$,@这3个符号编成UrlCode.请自行改造此函数然后使用. HTTPOptions := [hoNoParseMetaHTTPEquiv]; 当遇到Get某个网页,idh

delphi 线程实战用法

新版delphi,带有匿名函数功能,大大方便了使用者. 现使用匿名函数开发一个方便实用的线程类,简化线程调用. 1. uSyncObjs.pas,TSuperEvent对TEvent的改进 2. uThreadTList, 对TList的改进 3. uSuperThreadCommon.pas,公共类,继承TThreadList,带自动释放 4. uSuperThreadHelper.pas, 由TThread线程继承而来,一个方便的单独线程类,平时用它可以快速实现线程功能. 5. uSuper

Delphi ListView基本用法大全[delphi]

Delphi ListView基本用法大全 本文出处:http://hi.baidu.com/python120/item/4ea85f61af94e55b6895e6ac //增加项或列(字段) ListView1.Clear;ListView1.Columns.Clear;ListView1.Columns.Add;ListView1.Columns.Add;ListView1.Columns.Add;ListView1.Columns.Items[0].Caption:='id';List

Delphi Inputbox,InputQuery用法

Delphi :InputQuery,InputBox用法及区别 function InputQuery(const ACaption, APrompt: string; var Value: string): Boolean; InputQuery返回值为是否点了OK 输入的字符串放在了变量Value中 function InputBox(const ACaption, APrompt, ADefault: string): string; inputBox返回值是字符串,也就是输入的字符串

Delphi IdHttp组件+IdHttpServer组件实现文件下载服务

http://blog.csdn.net/xxkku521/article/details/16864759 Delphi IdHttp组件+IdHttpServer组件实现文件下载服务 2013-11-21 18:15 2624人阅读 评论(0) 收藏 举报  分类: DELPHI(10)  版权声明:本文为博主原创文章,未经博主允许不得转载. [delphi] view plain copy uses idhttp,IdHTTPServer; //idhttp组件提交下载请求 procedu

为何没有人用DELPHI IDHTTP + WEB做三层应用

---恢复内容开始--- 为何没有人用DELPHI IDHTTP + WEB + MYSQL(或其他数据库)做三层应用,我个人觉得这样做也不错.不过这样写需要开发人员懂的范围相对广一些,对于初入门的朋友来说,可能有点困难.需要对PHP或其他WEB框架有所认识,了解并懂得如何使用JSON. 现在JSON应用得这么广泛,DELPHI也支持(XE10肯定支持,其他版本不清楚,请自行测试). ThinkPHP是一个挺成熟的PHP框架,用它来做WEB层(服务层)是不错的选择,当然可以用其他的,例如JAVA

（转载）Delphi TStringList的用法

Delphi TStringList的用法 统一转换成Utf8AnsiToUtf8(sTmp);AnsiToUtf8('啊'); 或2010以上版本,全是UTF8了 TStrings是一个抽象类,在实际开发中,是除了基本类型外,应用得最多的. TStringList 常用方法与属性: var List: TStringList; i: Integer; begin List := TStringList.Create; List.Add('Strings1'); {添加} List.Add('S

Delphi IDHTTP用法详解

[delphi] view plaincopyprint? 一.IDHTTP的基本用法 IDHttp和WebBrowser一样,都可以实现抓取远端网页的功能,但是http方式更快.更节约资源,缺点是需要手动维护cook,连接等 IDHttp的创建,需要引入IDHttp procedure InitHttp(); begin http := TIdHTTP.Create(nil); http.ReadTimeout := 30000; http.OnRedirect := OnRedirect;

Delphi GDI+基本用法总结

GDI+以前只是听说过,还没怎么用过,这段时间用了用,觉得挺好用的.在这里总结一下.留个备忘. GDI+(Graphics Device Interface plus)是Windows XP中的一个子系统,它主要负责在显示屏幕和打印设备输出有关信息,它是一组通过C++类实现的应用程序编程接口.由于它是图形绘制相关的接口,那先了解一下常用的几种图片格式. 常见的图片格式 常见的图片格式有JPEG, BMP, PNG. - JPEG:它用有损压缩方式去除冗余的图像或彩色数据, 获取得极高的压缩率的同