Cobbler写的ADO连接池

 

(*******************************************************************************
  ADO连接池
   池未满的情况下 池子 ADO连接 动态创建
   系统默认池子中 一个小时以上未用的 ADO 连接 系统自动释放
   使用如下
   先Uses UntCobblerPool 单元
   在窗体 或 模块Create 事件中写
   ADOCobblerPool := TADOCobblerPool.Create(15,60,5000);
   在窗体 或 模块Close事件中写
   ADOCobblerPool.Free;
   调用如下 ado1 是TADODataset，TADOtable，TADOQuery
   ado1.Connection := ADOCobblerPool.GetADOCon(ss);
  try
    ado1.Open;
  finally
    ADOCobblerPool.FreeADOConUsed(ado1.Connection.Tag);
  end;
作者:Cobbler
     2011-1-23
     如有优化 请传作者一份 。谢谢！
     大富翁ID：eloveme
     邮箱：eloveme@tom.com
     QQ;250134558
********************************************************************************)
unit UntCobblerPool;
interface
uses
  Windows, DB, ADODB, classes, Dialogs, SysUtils, ExtCtrls, DateUtils;
type
  TADOCobbler = class
  private
    FFlag: boolean; //当前对象是否被使用
    FConnObj: TADOConnection; //数据库连接对象
    FConnStr: ShortString;//连接字符串
    FAStart: TDateTime;//最后一次活动时间
  public
    constructor Create(tmpConnStr:string);overload;
    destructor Destroy;override;
    property Flag:boolean  read FFlag write FFlag;
    property ConnObj: TADOConnection read FConnObj;
    property ConnStr: ShortString read FConnStr write FConnStr;
    property AStart: TDateTime read FAStart write FAStart;
  end;
type
  TADOCobblerPool = class
    procedure OnMyTimer(Sender: TObject);//做轮询用
  private
    FSection: TRTLCriticalSection;
    FPOOLNUMBER:Integer; //池大小
    FPollingInterval:Integer;//轮询时间 以 分 为单位
    FADOCobbler:TADOCobbler;//
    FList:TList;//用来管理连接TADOCobbler
    FTime :TTimer;//主要做轮询
    procedure Enter;
    procedure Leave;
  public
    constructor Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);overload;
    destructor Destroy;override;
    //从池中取出可用的ADO连接
    function GetADOCon(const tmpConnStr:string):TADOConnection;
    //回归至池中为可用
    procedure FreeADOConUsed(const iTag:Integer);
    //是否池中许久未用的ADO连接
    procedure FreeADOCon;
  end;
var
  ADOCobblerPool:TADOCobblerPool;
implementation
{ TADOCobbler }
constructor TADOCobbler.Create(tmpConnStr: string);
begin
  FConnObj := TADOConnection.Create(nil);
  FConnStr := tmpConnStr;
  FConnObj.ConnectionString := FConnStr;
  FConnObj.CommandTimeout := 30;
  FConnObj.ConnectionTimeout := 60;
  FConnObj.LoginPrompt := False;
  try
    FConnObj.Connected := True;
  except
  end;
end;
destructor TADOCobbler.Destroy;
begin
  FFlag := False;
  FConnStr := '';
  FAStart := 0;
  if Assigned(FConnObj) then FConnObj.Free;
  inherited;
end;
{ TADOCobblerPool }
constructor TADOCobblerPool.Create(const MaxNumBer:Integer;FreeMinutes :Integer= 60;TimerTime:Integer = 5000);
begin
  InitializeCriticalSection(FSection);
  FPOOLNUMBER := MaxNumBer; //设置池大小
  FPollingInterval := FreeMinutes;// 连接池中  FPollingInterval 以上没用的 自动回收连接池
  FList := TList.Create;
  FTime := TTimer.Create(nil);
  FTime.Interval := TimerTime;//5分钟检查一次
  FTime.OnTimer := OnMyTimer;
end;
destructor TADOCobblerPool.Destroy;
var
  i:integer;
begin
  for i := FList.Count - 1 downto 0  do
  begin
    try
      FADOCobbler := TADOCobbler(FList.Items);
      FreeAndNil(FADOCobbler);
      FList.Delete(i);
    except
    end;
  end;
  FList.Free;
  DeleteCriticalSection(FSection);
end;
procedure TADOCobblerPool.Enter;
begin
  EnterCriticalSection(FSection);
end;
procedure TADOCobblerPool.Leave;
begin
  LeaveCriticalSection(FSection);
end;
//根据字符串连接参数 取出当前连接池可以用ADO
function TADOCobblerPool.GetADOCon(const tmpConnStr:string):TADOConnection;
var
  i:Integer;
  IsResult :Boolean; //标识
  CurOutTime:Integer;
begin
  Result := nil;
  IsResult := False;
  CurOutTime := 0;
  Enter;
  try
    for I := 0 to FList.Count - 1 do
    begin
      FADOCobbler := TADOCobbler(FList.Items);
      if not FADOCobbler.Flag then //可用
      begin
        if SameStr(LowerCase(tmpConnStr),LowerCase(FADOCobbler.ConnStr)) then  //找到
        begin
          Result :=  FADOCobbler.ConnObj;
          Result.Tag := I+1;//为了误认0的状态
          FADOCobbler.Flag := True; //标记已经分配用了
          FADOCobbler.AStart := Now;//记录时间
          IsResult := True;
          Break;//退出循环
        end;
      end;
    end; // end for
  finally
    Leave;
  end;
  if IsResult then Exit;
  //池未满 新建一个
  Enter;
  try
    if FList.Count < FPOOLNUMBER then //池未满
    begin
      FADOCobbler := TADOCobbler.Create(tmpConnStr);
      Result :=  FADOCobbler.ConnObj;
      Result.Tag := FList.Count+1;
      FADOCobbler.Flag := True;
      FADOCobbler.AStart := Now;//记录时间
      IsResult := True;
      FList.Add(FADOCobbler);//假如管理
    end;
  finally
    Leave;
  end;
  if IsResult then Exit;
  //池满 等待 等候释放
  while True do
  begin
    Enter;
    try
      for I := 0 to FList.Count - 1 do
      begin
        FADOCobbler := TADOCobbler(FList.Items);
        if SameStr(LowerCase(tmpConnStr),LowerCase(FADOCobbler.ConnStr)) then  //找到
        begin
          if not FADOCobbler.Flag then //可用
          begin
            Result :=  FADOCobbler.ConnObj;
            Result.Tag := I+1;
            FADOCobbler.Flag := True; //标记已经分配用了
            FADOCobbler.AStart := Now;//记录时间
            IsResult := True;
            Break;//退出循环
          end;
        end;
      end; // end for
      if IsResult then Break; //找到退出
    finally
      Leave;
    end;
    //如果不存在这种字符串的池子 则 一直等到超时
    if CurOutTime >= 5000 * 6 then  //1分钟
    begin
      raise Exception.Create('连接超时!');
      Break;
    end;
    Sleep(500);//0.5秒钟
    CurOutTime := CurOutTime + 500; //超时设置成60秒
  end;//end while
end;
procedure TADOCobblerPool.FreeADOConUsed(const iTag: Integer);
begin
  Enter;
  try
    if iTag < 1 then Exit;
    if FList.Count < 1 then Exit;
    if FList.Count < iTag - 1 then Exit;
    FADOCobbler := TADOCobbler(FList.Items[iTag - 1]);
    FADOCobbler.Flag := False;
    FADOCobbler.AStart := Now;//最后活动时间
  finally
    Leave;
  end;
end;

procedure TADOCobblerPool.FreeADOCon;
var
  i:Integer;
  function MyMinutesBetween(const ANow, AThen: TDateTime): Integer;
  begin
    Result := Round(MinuteSpan(ANow, AThen));
  end;
begin
  Enter;
  try
    for I := FList.Count - 1 downto 0 do
    begin
      FADOCobbler := TADOCobbler(FList.Items);
      if MyMinutesBetween(Now,FADOCobbler.AStart) >= FPollingInterval then //释放池子许久不用的ADO
      begin
        FreeAndNil(FADOCobbler);
        FList.Delete(I);
      end;
    end;
  finally
    Leave;
  end;
end;
procedure TADOCobblerPool.OnMyTimer(Sender: TObject);
begin
  FreeADOCon;
end;
end.