自己整理的数据库连接池

这是从网上收集资料重新整理后的一个数据库连接池管理类，目前实现了下面三项功能，

1数据库连接数量的限制

2自动断开设定时间内没有使用过的数据库连接

3单例模式中多线程的异步访问控制

单元文件unit utConnManage;

unit utConnManage;

interface
uses ADODB,DB,Classes,SyncObjs,Windows,SysUtils,Controls, ActiveX,Dialogs,
  utRWConfig,DateUtils,utIntervalThread;

type
  PCon = ^TPCon; 
  TPCon = record
    Id  :Integer;
    Intf: TADOConnection;
    InUse: Boolean;
    //记录最后调用或释放时间，如果Conn 2分钟未使用 则关闭Connection
    LastSetTime:TDateTime;
  end;
//------------------------------------------------------------------------------
//类名:TConnManage
//功能:对数据库连接的简单管理 ,采用单例模式
//------------------------------------------------------------------------------
  TConnManage=class(TObject)
  private
    m_ConList :TList; 
    m_CriticalSection:TCriticalSection;
    FSemaphore:Thandle;
    //定时执行的线程类
    m_tIntervalThread:TIntervalThread;
    //返回连接字符串
    function GetLinkStr:string;
    //检查连接是否长时间空闲
    procedure CloseConnOnLongTimeIdle(Sender:TObject);
  protected
    function CreatenewInstance: TADOConnection;
    function GetLock(Index: Integer): Boolean;
    procedure GetConnListState(pTips:string);   
  public
    constructor Create;
    destructor Destroy; override;
    //锁定一个数据库连接
    function LockCon:TADOConnection;
    //释放一个数据库连接
    procedure UnLockCon(var Value:TADOConnection);
    class function InStance:TConnManage;
  end;

implementation

uses utLogger;
var
  ConnMange:TConnManage;
{ TConnManage }

procedure TConnManage.CloseConnOnLongTimeIdle(Sender: TObject);
var
  i:Integer;
begin
  m_CriticalSection.Enter;
  try   
    for i := 0 to m_ConList.Count - 1 do
      if (Trunc(SecondSpan(Now,PCon(m_ConList[i]).LastSetTime))>120) and
        (PCon(m_ConList[i]).Intf.Connected) then
      begin
        PCon(m_ConList[i]).Intf.Connected:=False;
        PCon(m_ConList[i]).LastSetTime:=Now;
      end;        
  finally
    m_CriticalSection.Leave;
  end;  
end;

constructor TConnManage.Create;
begin
  m_ConList :=TList.Create;
  m_CriticalSection :=TCriticalSection.Create;
  FSemaphore :=CreateSemaphore(nil,5,5,'');

  m_tIntervalThread:=TIntervalThread.create;
  m_tIntervalThread.Interval:=60;
  m_tIntervalThread.OnExecEvent:=CloseConnOnLongTimeIdle;
  m_tIntervalThread.Resume;
end;

function TConnManage.CreatenewInstance: TADOConnection;
var
  P: PCon;
begin
  Result := nil;
  try
    New(p);
    P.Id :=m_ConList.Count+1;
    CoInitialize(nil);
    p.Intf :=TADOConnection.Create(nil);
    p.Intf.ConnectionString :=GetLinkStr;
    p.Intf.LoginPrompt :=False;
    try
      p.Intf.Open;
      p.InUse := True;
      p.LastSetTime:=Now;
      m_ConList.Add(p);
      Result :=p.Intf;
    except
      on e:exception do
      begin
        p.Intf.Free;
        Dispose(P);
       // TGlobalError.SetContext(e.Message);
      //      raise  Exception.Create('系统配置文件(SysConfig.ini)错误，请将其更正后再运行系统!');
      end;
    end;
  finally
    CoUninitialize;    
  end;
end;

destructor TConnManage.Destroy;
var
  i:Integer;
begin
  m_tIntervalThread.SetOver;
  m_tIntervalThread.TerminateFlag:=True;
  Sleep(500);
  for I := 0 to m_ConList.Count - 1 do
  begin
    PCon(m_ConList[i]).Intf.Close;
    PCon(m_ConList[i]).Intf.Free;
    Dispose(m_ConList[i]);
  end;
  m_ConList.Free;
  m_CriticalSection.Free;
  CloseHandle(FSemaphore);
  inherited;
end;function TConnManage.GetLinkStr: string;
begin
  Result:=Format('Provider=SQLOLEDB.1;Password=%s;Persist Security Info=True;User ID=%s'
    +';Initial Catalog=%s;Data Source=%s',
      [TRWConfig.ReadConfigStrValue('DBServer','DBPwd'),
      TRWConfig.ReadConfigStrValue('DBServer','DBUser'),
      TRWConfig.ReadConfigStrValue('DBServer','DBName'),
      TRWConfig.ReadConfigStrValue('DBServer','ServerName')]);
end;

function TConnManage.GetLock(Index: Integer): Boolean;
begin
  Result :=not Pcon(m_ConList[Index]).InUse;
  if Result then
  begin
    //Connected的值是不真实的,需要换种思路解决.
    //数据库连接断开的问题
    
    if not Pcon(m_ConList[Index]).Intf.Connected then
    begin
      try       
        Pcon(m_ConList[Index]).Intf.ConnectionString:=GetLinkStr;
        pcon(m_ConList[Index]).Intf.CommandTimeout:=3000;
        Pcon(m_ConList[Index]).Intf.Connected:=True;
      except
        Exit;
      end;
    end;
    Pcon(m_ConList[Index]).InUse :=True;
    Pcon(m_ConList[Index]).LastSetTime:=Now;
  end;
end;

class function TConnManage.InStance: TConnManage;
begin
  Result:=ConnMange;
end;

function TConnManage.LockCon: TADOConnection;
var
  i:Integer;
  WaitResult:DWORD;
begin
  Result:=nil;
  WaitResult:= WaitForSingleObject(FSemaphore,2000);
  if WaitResult=WAIT_TIMEOUT then
    Exit;
  m_CriticalSection.Enter;
  try
    for i:=0 to self.m_ConList.Count-1 do
    begin
      if GetLock(i) then
      begin
        Result :=PCon(self.m_ConList[i]).Intf;
        GetConnListState('返回Connection'+IntToStr(i));
        Exit;
      end;
    end;
    if self.m_ConList.Count< 5 then
      Result :=self.CreatenewInstance;
{    if Result=nil then
      GetConnListState('返回Connection Nil')
    else
      GetConnListState('返回Connection 新创建的');  }
  finally
    m_CriticalSection.Leave;
  end;
  
end;

procedure TConnManage.UnLockCon(var Value: TADOConnection);
var
 i: Integer;
begin
  for i:=0 to m_ConList.Count-1 do
  begin
   if Value=Pcon(m_ConList[i]).Intf then
    begin
      m_CriticalSection.Enter;
      try
        PCon(self.m_ConList[i]).InUse :=False;
        PCon(self.m_ConList[i]).LastSetTime :=Now;
        ReleaseSemaphore(FSemaphore,1,nil);
      finally
//        GetConnListState('释放Connection '+IntToStr(i));
        m_CriticalSection.Leave;
      end;        
      Break;
    end;
  end;
end;

initialization
  ConnMange:=TConnManage.Create;
finalization
  ConnMange.Free;

循环执行线程类:

　单元文件:utIntervalThread

unit utIntervalThread;

interface

uses Classes,Windows,SysUtils,MMSystem;

type
  TIntervalThread=class(TThread)
  private
    fInterval: Integer;
    timerid:integer;
    htimerevent:Thandle;
    fTerminateFlag: Boolean;
    procedure SetInterval(Value: Integer);
  protected
    procedure Execute;override;
  public
    OnExecEvent:TNotifyEvent;
    constructor create;
    procedure SetOver;
  published     
    property Interval:Integer read fInterval write SetInterval;
    property TerminateFlag: Boolean read fTerminateFlag write fTerminateFlag;
  end;
  
implementation

{ TIntervalThread }

constructor TIntervalThread.create;
begin
  FreeOnTerminate := true;
  Inherited Create(true);
end;

procedure TIntervalThread.Execute;
begin
  inherited;
  htimerevent := CreateEvent(nil, False, False, nil);
  timerid := timesetevent(FInterval*1000,0,TFNTimecallback(htimerevent),0,time_periodic or time_callback_event_set);
  repeat
    if WaitForSingleObject(htimerevent,INFINITE) = WAIT_OBJECT_0 then
    begin
      if fTerminateFlag then break;
      //DoSomething;

      if Assigned(OnExecEvent) then
        OnExecEvent(nil);
    end;
  until false;
  timekillevent(timerid);
  CloseHandle(htimerevent);
end;

procedure TIntervalThread.SetInterval(Value: Integer);
begin
  if Interval <> Value then
    fInterval := Value;
end;

procedure TIntervalThread.SetOver;
begin
  timerid:=timesetevent(5,0,TFNTimecallback(htimerevent),0,time_periodic or time_callback_event_set);
end;

end.