Delphi 2007 创建TIdHttp对象连接池

于 2020-08-16 11:56:42 发布
阅读量597 收藏 2
点赞数
分类专栏： Delphi
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/ceaningking/article/details/108034120
版权

程序经常用到TIDHttp,每次封装模块的时候都要去创建1-2个TIdHttp对象，感觉很繁琐。就想把TIdHttp的东西写成一个公共代码模块，需要用的时候直接去取就可以了，不用每次都Create, FreeAndNil。

现模仿数据库连接池，来写一个TIdHttpd对象连接池。

1. 配置文件HTTP.ini

[Options]
;允许最小连接数
iMin=10
;允许最大连接数
iMax=50
;是否使用https
bUseHttps=1
;纯模式 混合模式
iHttpMode=1
;请求类型
iContentType=1
;空闲连接时长允许销毁
iIldeSec=300
;http(s)请求超时时间
iReqSec=10

   在TIDHttp创建对象时，经常进行如下设置

  

Request.ContentType := 'application/x-www-form-urlencoded';
Request.ContentType := 'application/json; charset=UTF-8';

   参数中的iContentType 0为application/x-www-form-urlencoded 1为application/json

   该参数只有在iHttpMode=0的时候才有效

   iHttpMode=0 表示TIdHttp对象的ContentType属性都是统一的

   要么都是application/x-www-form-urlencoded，要么都是application/json

   该模式下，会启动连接池的定时清理任务，清楚多于的，清楚超时的。

   iHttpMode=1 表示TIdHttp对象的Content属性不是统一的

   该模式下，为了简单，将连接池一半设置为application/x-www-form-urlencoded，一半为application/json

   该模式下，会关闭连接池定时清理任务，且连接池数量直接取iMax值. 不允许新增连接对象。

   iIldeSec表示一个空闲连接对象在iIldeSec(秒)时间内没有被调用过，且满足释放条件，则会被释放掉

   该参数在iHttpMode=0有效

   iReqSec表示TIdHttp对象的请求超时时间，单位：秒

   bUseHttps表示是否启用Https请求，默认0表示不启用，1表示启用(额外需要libeay32.dll和ssleay32.dll)。

2. 封装代码uIdHttpPools.pas

unit uIdHttpPools;

interface

uses
  Windows, IdHTTP, SysUtils, Classes, Contnrs, ExtCtrls, DateUtils, 
  IdSSLOpenSSLHeaders, IdSSLOpenSSL, IniFiles;

const
  GMin= 10;
  GMax= 50;
  GIldeSec= 300;
  GReqSec= 10;

type
  //对默认最小连接 最大连接 与ini设置的最小连接和最大连接作取舍对比
  TMCheck= (tmMin, tmMax);
  //  mpDefault  x-www-form-urlencoded
  //  mpJson     json
  TContentType= (mpDefault, mpJson);
  //  moSingle   全x-www-form-urlencoded 或 全json      
  //  moMix      以上两者的混合模式 各占一半
  THttpMode= (moSingle, moMix);  

  THttpConnection= class(TIdHttp)
  public
    //日志记录
    procedure writeLog(sMethod, sMsg: string);
    //Post请求
    function SendPost(sMethod, sUrl: string; sParams: TStringList; var sOut, sErr: string): Boolean;
    //Get请求
    function SendGet(sMethod, sUrl: string; var sOut, sErr: string): Boolean;
  end;

  THttpConnPool= class(TComponent)
  private
    // 模式
    // 0 纯模式  要么全是application/json 要么全是application/x-www-form-urlencoded
    // 1 混模式  既有application/json 也有application/x-www-form-urlencoded
    fHttpMode: THttpMode;
    // 类型 fHttpMode=1时 此参数无效
    // 0 application/x-www-form-urlencoded
    // 1 application/json
    fContentType: TContentType;
    fConnList: TComponentList;                                    //连接池对象容器
    fCleanTimer: TTimer;                                          //连接池定时器
    procedure fCleanTimerEvent(sender: TObject);                  //连接池定时轮询Timer
    procedure fClean;                                             //清理允许范围内的空闲连接池
    function fCreateHttpConn(bMix, bEve: Boolean; _type: TContentType): THttpConnection; //创建一个连接对象
    procedure readLocalParams;                                    //读取本地配置
  protected
    procedure writeLog(sMsg: string);                             //日志记录
    function getConnCount: Integer;                               //获取连接池数量
    function getUnixTimestampSecond: Integer;
  public
    fDefault: Integer;                                            //默认连接池数量20
    fMin    : Integer;                                            //允许最小连接数
    fMax    : Integer;                                            //允许最大连接数
    // fHttpMode=0 模式下 当某连接超过fIldeSec(秒)内没有使用过 满足释放的条件则释放该连接
    fIldeSec: Integer;
    // fHttpMode=0 模式下 当某连接请求超时 超过fReqSec(秒)内没有应答 满足释放的条件则释放该连接
    fReqSec : Integer;
    fUseHttps: Boolean;                                           //使用使用https模式
    FArr_ContentType: array of Byte;                              //记录类型 配合moMix使用
    property HttpMode: THttpMode read fHttpMode;                  //模式
    property ContentType: TContentType read fContentType;         //类型
    property ConnCount: integer read getConnCount;                //当前连接池连接数量
    constructor Create(owner: TComponent);
    function getHttpConn: THttpConnection;                        //纯模式获取连接
    function getHttpConnMix(iType: Byte): THttpConnection;        //混模式获取连接
    function returnHttpConn(conn: THttpConnection): Boolean;      //归还连接
  end;

implementation

uses uPathUtils;

function getCheck(tmCheck: TMCheck; iValue: integer): Integer;
begin
  Result:= iValue;
  //必须首先确定fMin
  if tmCheck= tmMin then
  begin
    if iValue< GMin then
      Result:= GMin
    else if iValue> GMax then
      Result:= GMax
    else
      Result:= iValue;
  end;
  if tmCheck= tmMax then
  begin
    if iValue< GMax then
      Result:= iValue
    else
      Result:= GMax;
  end;
end;

{ THttpConnection }

function THttpConnection.SendGet(sMethod, sUrl: string; var sOut, sErr: string): Boolean;
var
  response: TStringStream;
begin
  Result:= False;
  sOut:= '';
  sErr:= '';
  if Connected then
    Disconnect;
  response:= TStringStream.Create('');
  try
    try
      writeLog(sMethod, '[send]-'+ sUrl);
      Get(sUrl, response);
      writeLog(sMethod, '[recv]-'+ response.DataString);
      sOut:= UTF8Decode(response.DataString);
      Result:= True;
    except
      on e: Exception do
      begin
        sErr:= e.Message;
        writeLog(sMethod, '[Err]-'+ e.Message);
      end;
    end;
  finally
    FreeAndNil(response);
    if Connected then
      Disconnect;
  end;
end;

function THttpConnection.SendPost(sMethod, sUrl: string; sParams: TStringList;
  var sOut, sErr: string): Boolean;
begin
  Result:= False;
  sOut:= '';
  sErr:= '';
  if Connected then
    Disconnect;
  try
    try
      writeLog(sMethod, '[send]-'+ sUrl);
      sOut:= UTF8Decode(Post(sUrl, sParams));
      writeLog(sMethod, '[recv]-'+ sOut);
      Result:= True;
    except
      on e: Exception do
      begin
        sErr:= e.Message;
        writeLog(sMethod, '[Err]-'+ e.Message);
      end;
    end;
  finally
    if Connected then
      Disconnect;
  end;
end;

procedure THttpConnection.writeLog(sMethod, sMsg: string);
var
  F: TextFile;
  FileName: string;
  ExeRoad: string;
begin
  try
    ExeRoad := ExtractFilePath(ParamStr(0));
    if ExeRoad[Length(ExeRoad)] = '\' then
      SetLength(ExeRoad, Length(ExeRoad) - 1);
    if not DirectoryExists(ExeRoad + 'log') then
    begin
      CreateDir(ExeRoad + '\log');
    end;
    FileName := ExeRoad + '\log\Http_Log' + FormatDateTime('YYMMDD', NOW) + '.txt';
    if not FileExists(FileName) then
    begin
      AssignFile(F, FileName);
      ReWrite(F);
    end
    else
      AssignFile(F, FileName);
    Append(F);
    Writeln(F, Format('%s [%s]: %s', [FormatDateTime('HH:NN:SS.zzz', Now), sMethod, sMsg]));
    CloseFile(F);
  except
    //可能在事务中调用,避免意外
    Exit;
  end;
end;

{ THttpConnPool }

constructor THttpConnPool.Create(owner: TComponent);
var
  index: Integer;
begin
  inherited Create(owner);
  fDefault:= 20;
  readLocalParams;
  if fConnList = nil then
  begin
    fConnList := TComponentList.Create;             // 创建连接池容器
    case fHttpMode of
      moSingle:
        begin
          for index := 1 to fDefault do
            fConnList.Add(fCreateHttpConn(fHttpMode= moMix, False, fContentType));
        end;
      moMix: //该模式下 直接取fMax值 fContentType比例各占一半  配置文件fMin=fMax
        begin
          SetLength(FArr_ContentType, fMax);
          for index := 1 to fMax do                   // 创建连接对象
          begin
            fConnList.Add(fCreateHttpConn(fHttpMode= moMix, (index mod 2)= 0, fContentType));
            FArr_ContentType[index- 1]:= (index mod 2);  //1是默认 0是json
          end;
        end;
    end;
  end;
  if (fCleanTimer = nil) and (fHttpMode= moSingle) then // 定时轮询连接池 混合模式不执行
  begin
    fCleanTimer := TTimer.Create(Self);
    fCleanTimer.Name := 'CleanTimer';
    fCleanTimer.Interval := 60* 1000;     //一分钟执行一次
    fCleanTimer.OnTimer := fCleanTimerEvent;
    fCleanTimer.Enabled := True;
  end;
end;

procedure THttpConnPool.fClean;
var
  index, iNow: Integer;
begin
  iNow := getUnixTimestampSecond;
  // 遍历连接池
  for index := fConnList.Count - 1 downto 0 do
  begin
    if THttpConnection(fConnList[index]).Tag > 0 then       // 未使用的连接
    begin
      if fConnList.Count > fMin then      // 连接池内连接总数 > 最小保留连接数量
      begin
        if iNow- THttpConnection(fConnList[index]).Tag> fIldeSec then   //有多长时间该连接没有使用了
          fConnList.Delete(index);                          // 从连接池内释放此连接对象
      end;
    end
    else if THttpConnection(fConnList[index]).Tag < 0 then   // 正在使用中的连接
    begin
      if iNow+ THttpConnection(fConnList[index]).Tag> fReqSec then  //删除请求超时
      begin
        fConnList.Delete(index);
        if fConnList.Count< fMin then
          fConnList.Add(fCreateHttpConn(fHttpMode= moMix, False, fContentType));
      end;
    end
  end;
end;

procedure THttpConnPool.fCleanTimerEvent(sender: TObject);
begin
  TTimer(sender).Enabled:= False;
  try
    try
      fClean;
    except
      on e: Exception do
        writeLog(e.Message);
    end;
  finally
    TTimer(sender).Enabled:= True;
  end;
end;

function THttpConnPool.fCreateHttpConn(bMix, bEve: Boolean; _type: TContentType): THttpConnection;
var
  idHttp: THttpConnection;
  IdSSL  : TIdSSLIOHandlerSocketOpenSSL;
begin
  Result:= nil;
  idHttp:= THttpConnection.Create(Self);
  with idHttp do
  begin
    Tag:= getUnixTimestampSecond;
    AllowCookies := True;
    HTTPOptions := [];
    ProtocolVersion := pv1_1;
    if bMix then
    begin
      if bEve then
        Request.ContentType := 'application/json'
      else
        Request.ContentType := 'application/x-www-form-urlencoded';
    end
    else
    begin
      case _type of
        mpDefault:  Request.ContentType := 'application/x-www-form-urlencoded';
        mpJson:     Request.ContentType := 'application/json; charset=UTF-8';
      end;
    end;
    Request.UserAgent := 'Mozilla/4.0 (compatible; Win32; WinHttp.WinHttpRequest.5)';
    Request.Accept := '*/*';
    Request.AcceptEncoding := '';
    Request.AcceptCharSet := 'UTF-8';
    Request.Connection := 'close';
    Request.AcceptLanguage := 'zh-cn';
    ReadTimeout := fReqSec* 1000;
    ConnectTimeout := 3000;
  end;

  if fUseHttps then
  begin
    IdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(Self);
    IdSSL.SSLOptions.Method := sslvSSLv23;
    IdSSL.SSLOptions.Mode := sslmClient;
    idHttp.IOHandler := IdSSL;
  end;
  {
    note:
    Create(nil);//需要自己释放
    Create(Self);//当Self释放时自动触发释放
    Create(Application);//当Application释放时自动释放
  }
  Result:= idHttp;
end;

function THttpConnPool.getConnCount: Integer;
begin
  Result:= fConnList.Count;
end;

function THttpConnPool.getHttpConn: THttpConnection;
var
  index: Integer;
begin
  Result:= nil;
  for index := 0 to fConnList.Count - 1 do
  begin
    if THttpConnection(fConnList[index]).Tag> 0 then  //未使用的连接
    begin
      Result:= THttpConnection(fConnList[index]);
      Result.Tag:= - getUnixTimestampSecond;    //tag设置为负数 表示已使用
      Break;
    end;
  end;
  if (Result= nil) and (index< fMax) then
  begin
    case fHttpMode of
      moSingle:
        begin
          Result:= fCreateHttpConn(fHttpMode= moMix, False, fContentType);
          Result.Tag:= - getUnixTimestampSecond;    //tag设置为负数 表示已使用
        end;
      moMix:    Result:= nil;  //混合模式固定连接数 不允许增加
    end;
    fConnList.Add(Result);
  end;
  if (Result<> nil) and Result.Connected then
    Result.Disconnect;
end;

function THttpConnPool.getHttpConnMix(iType: Byte): THttpConnection;
var
  index: Integer;
begin
  Result:= nil;
  //混模式 连接数固定 不允许新增
  for index := 0 to fConnList.Count - 1 do
  begin
    //tag> 0 表示空闲  iType=1 默认 0 json
    if (THttpConnection(fConnList[index]).Tag> 0) and (FArr_ContentType[index]= iType) then
    begin
      Result:= THttpConnection(fConnList[index]);
      Result.Tag:= - getUnixTimestampSecond;    //tag设置为负数 表示已使用
      Break;
    end;
  end;
  if (Result<> nil) and Result.Connected then
    Result.Disconnect;
end;

function THttpConnPool.getUnixTimestampSecond: Integer;
begin
  Result := DateTimeToUnix(Now)- 8* 60* 60;
end;

procedure THttpConnPool.readLocalParams;
var
  sFile: string;
  sIni: TIniFile;
begin
  sFile := TFilePath.HTTP_IniFile;
  if FileExists(sFile) then
  begin
    sIni := TIniFile.Create(sFile);
    try
      fMin        := getCheck(tmMin, sIni.ReadInteger('Options', 'iMin', GMin));
      fMax        := getCheck(tmMax, sIni.ReadInteger('Options', 'iMax', GMax));
      if fMax< fMin then
        fMax:= fMin;
      fUseHttps   := sIni.ReadBool('Options', 'bUseHttps', False);
      fHttpMode   := THttpMode(sIni.ReadInteger('Options', 'iHttpMode', 0));
      fContentType:= TContentType(sIni.ReadInteger('Options', 'iContentType', 0));
      fIldeSec    := sIni.ReadInteger('Options', 'iIldeSec', 300);
      fReqSec     := sIni.ReadInteger('Options', 'iReqSec', 3);
    finally
      FreeAndNil(sIni);
    end;
  end;
end;

function THttpConnPool.returnHttpConn(conn: THttpConnection): Boolean;
begin
  Result:= fConnList.IndexOf(conn)> -1;
  if Result then
  begin
    if conn.Connected then
      conn.Disconnect;
    conn.Tag:= getUnixTimestampSecond;    //标记可用
  end;
end;

procedure THttpConnPool.writeLog(sMsg: string);
var
  F: TextFile;
  FileName: string;
  ExeRoad: string;
begin
  try
    ExeRoad := ExtractFilePath(ParamStr(0));
    if ExeRoad[Length(ExeRoad)] = '\' then
      SetLength(ExeRoad, Length(ExeRoad) - 1);
    if not DirectoryExists(ExeRoad + 'log') then
    begin
      CreateDir(ExeRoad + '\log');
    end;
    FileName := ExeRoad + '\log\POOL_Log' + FormatDateTime('YYMMDD', NOW) + '.txt';
    if not FileExists(FileName) then
    begin
      AssignFile(F, FileName);
      ReWrite(F);
    end
    else
      AssignFile(F, FileName);
    Append(F);
    Writeln(F, Format('%s %s', [FormatDateTime('HH:NN:SS.zzz', Now), sMsg]));
    CloseFile(F);
  except
    //可能在事务中调用,避免意外
    Exit;
  end;
end;

end.

 本地测试了下，效果还不错。在今后的开发中，如果再遇到网络请求的情况，就应用于实际。

 写的不好，在后期需要完善，先写下备份下。

ceaningking
关注
  • 0
    点赞
  • 踩
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值