• 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

  • 相关阅读:
    intersect参数
    创建图层只是保存lyr,此路不通
    点在线上
    GPS点和底图叠加
    Ifeature.set_value(index,value)怎么没结果,请高手指点
    GP的输入参数
    关于调用ArcGIS中GP工具.Erase、SymDiff
    ArcEngine 导出图层(shp)
    转载 高效实用的异或操作
    判断一个整数是否是奇数的小解
  • 原文地址:https://www.cnblogs.com/findumars/p/5648530.html
Copyright © 2020-2023  润新知