上篇提到了在XE～XE6下安装UniDac。这篇，就基于UniDac，实现一个简单的数据库连接池。

文本的目录：

1、简单描述连接池实现的好处和原理；

2、连接池实现代码；

3、给出使用连接池的Demo（窗体文件代码 和 实现Pas代码）；

本文所有的代码在XE环境上测试通过。如果要运行在XE以下版本，Demo请根据实现情况作修改。

1、简单描述连接池实现的好处和原理

现在开始介绍第1点，使用Delphi开发数据库应用软件，那是一把利器。当然，Delphi也能开发其它类型的产品，比如游戏之类，盛大的传奇就是用Delphi开发的；当然今天的话是数据库应用。很多的ERP，我了解的金蝶ERP和用友ERP就是用Delphi开发的，当然他们也有Web版本。MIS系统初期时基于单机版本，现在很多财务软件就有单机版本，后来发展成C/S架构，就是客户端-服务端架构，客户端提供UI界面，服务端实现业务逻辑；在后来就发展到多层结构，一直到N层，实现分布式结构。其实不管是单机结构，还是C/S结构，还是发展到目前的三层及多层结构，本身并对业务逻辑的编写，并没有多大差别。资料的CURD（C=Create，U=Update，R=Read ，D=Delete）操作都是一样。这就涉及到一个问题。在连接数据库，包括ODBC，ADO，ADO.net 还是 DBExpress，还是第三方的连接驱动，都是程序和数据库的连接通道，本文的UniDac也是一个通道。我们知道每一次数据库连接，都是需要消耗资源，包括TCP/IP连接，SQL缓存等开销。现在的问题，如果有一个 Pool,能把每次申请的SQLConnetion用完后，再放回池里，不释放，以备下次使用，那样不是节省了开销，又增加了效率，让连接访问数据库为更快速，特别是多线程下，对数据库的访问。那么实现原理是什么呢？可以设计简单或设计复杂，这要视实际情况而定。一般的思路，池对外提供一个接口，供程序调用。如果没有SQL连接，池自己生产一个，返回SQL连接对象；程序调用完，池就回收，不实际释放，等待下次调用。这里有个问题，就是控制池的最大连接数问题，不过对于一般的应用，这个问题可以先不用考虑。下面是访问时序图：

2、连接池实现代码：

 { Author:
  Purpose:   数据库连接池单元
  History:
  Modify
  desc: 本连接池针对MySQL数据库，根据实际情况，可以配置MSSQL，Oracle，DB2，SQLite等，当然具体中，要稍作修改
}

unit SqlConPool;

interface

uses
  SysUtils, Windows, Classes, IniFiles, Uni,
  MySQlUniProvider, MemDS;
// const
// AESKey = '3ABE2C927E89407D95AF-B4DCB0AD76FEF8F45194167A465F94C29E2ABB6E67C2';

type

  TSQLConntionRecord = record
    HostName: string;
    Port: Integer;
    UserName: string;
    DBName: string;
    MyDataBase: string;
    Password: string;
  end;

  TSQLConnectionPool = class
  private
    FDbType: string;
    FConList: TThreadList;
    function TestConnection(con: TUniConnection): boolean;
    function GetConnection: TUniConnection;
    function GetConnectionRecord: TSQLConntionRecord;
  public
    function Pop: TUniConnection;
    procedure Push(con: TUniConnection);
    constructor CreatePool;
    destructor Destroy; override;
    function GetDbType: string;
    function PoolCount: Integer;
  end;

  TQryPool = class
  private
    function GetQry: TUniQuery;
    procedure con(qry: TUniQuery);
    procedure discon(qry: TUniQuery);
  public
    function Pop: TUniQuery;
    procedure Push(qry: TUniQuery);
  end;

var
  SQLConnectionPools: TSQLConnectionPool;
  QryPools: TQryPool;

implementation

{ TSQLConnectionPool }

constructor TSQLConnectionPool.CreatePool;
begin
  FConList := TThreadList.Create;
  FDbType := 'MYSQL';
end;

destructor TSQLConnectionPool.Destroy;
var
  i: Integer;
begin
  with FConList.LockList do
    try
      for i := Count - 1 downto 0 do
      begin
        TUniConnection(Items[i]).Close;
        TUniConnection(Items[i]).Free;
      end;
    finally
      FConList.UnlockList;
    end;

  FConList.Free;
end;


//获取SQL连接对象
function TSQLConnectionPool.GetConnection: TUniConnection;
var
  con: TUniConnection;
  RecCon: TSQLConntionRecord;
begin
  Result := nil;
  try
    con := TUniConnection.Create(nil);
    RecCon := GetConnectionRecord;
    try

      with con do
      begin
        LoginPrompt := false;
        ProviderName := RecCon.MyDataBase;
        UserName := RecCon.UserName;
        Password := RecCon.Password;
        Server := RecCon.HostName;
        Database := RecCon.DBName;
        Port := RecCon.Port;
        // 解决中文乱码，UniCode编码
        SpecificOptions.Values['UseUnicode'] := 'True';
        Connect;
      end;
      Result := con;
    except
      on E: exception do
      begin
        Result := nil;
        con.Free;
        // 打印日志。。。。
      end;
    end;
  except
  end;
end;

//获取配置SQL连接参数
function TSQLConnectionPool.GetConnectionRecord: TSQLConntionRecord;
var
  dbIni: TIniFile;
begin
  dbIni := TIniFile.Create(ExpandFileName(ExtractFilePath(ParamStr(0)) +
    '\DataBase.ini'));
  try
    with Result do
    begin
      HostName := dbIni.ReadString('Database', 'Host', '');
      Port := dbIni.ReadInteger('Database', 'Port', 3306);
      UserName := dbIni.ReadString('Database', 'UID', '');
      DBName := dbIni.ReadString('Database', 'Database', '');
      MyDataBase := UpperCase(dbIni.ReadString('Database', 'DataBaseType',
        'MySql'));
      Password := dbIni.ReadString('Database', 'Password', '');
      // 如果要加密处理，就通过DES或AES加密
      // Password := string(AesDecryptString(dbIni.ReadString('Database',
      // 'Password', ''), AESKey));
    end;
  finally
    dbIni.Free;
  end;
end;

//获取数据库类型，UniDac支持多种数据库类型，可以通过配置文件配置
function TSQLConnectionPool.GetDbType: string;
begin
  Result := FDbType;
end;


//获取连接池SQL对象个数
function TSQLConnectionPool.PoolCount: Integer;
begin
  with FConList.LockList do
    try
      Result := Count;
    finally
      FConList.UnlockList;
    end;

end;

//弹出SQL连接对象
function TSQLConnectionPool.Pop: TUniConnection;
begin
  with FConList.LockList do
    try
      if Count > 0 then
      begin
        Result := TUniConnection(Items[0]);
        Delete(0);
        if not TestConnection(Result) then
        begin
          Result.Free;
          Result := Pop;
        end;
      end
      else
      begin
        Result := GetConnection;
      end
    finally
      FConList.UnlockList;
    end;
end;

//回收SQL连接对象
procedure TSQLConnectionPool.Push(con: TUniConnection);
begin
  if con <> nil then
    with FConList.LockList do
      try
        Insert(0, con);
      finally
        FConList.UnlockList;
      end;
end;


//测试连接池中的SQL对象是否存活
function TSQLConnectionPool.TestConnection(con: TUniConnection): boolean;
begin
  Result := false;
  try
    con.ExecSQL('delete from dbcon where 1<>1', []);

    Result := true;
  except
    on E: exception do
    begin
      // 实际应用，一定要打印日志
    end;

  end;
end;

{ TQryPool }


//qry 关联SQL Connection
procedure TQryPool.con(qry: TUniQuery);
var
  sqlcon: TUniConnection;
begin
  sqlcon := SQLConnectionPools.Pop;
  qry.Connection := sqlcon;
end;


//回收SQL Connetion 对象
procedure TQryPool.discon(qry: TUniQuery);
begin
  SQLConnectionPools.Push(qry.Connection);
end;


//获取对象
function TQryPool.GetQry: TUniQuery;
var
  qry: TUniQuery;
begin
  qry := TUniQuery.Create(nil);
  con(qry);
  Result := qry;
end;

//弹出Qry对象
function TQryPool.Pop: TUniQuery;
begin
  Result := GetQry;
end;

//获取Qry对象
procedure TQryPool.Push(qry: TUniQuery);
begin
  if qry <> nil then
  begin
    qry.Close;
    discon(qry);
    qry.Free;
  end;
end;

initialization

SQLConnectionPools := TSQLConnectionPool.CreatePool();
QryPools := TQryPool.Create;

finalization

if QryPools <> nil then
begin
  QryPools.Free;
  QryPools := nil;
end;
if SQLConnectionPools <> nil then
begin
  SQLConnectionPools.Free;
  SQLConnectionPools := nil;
end;

end.

3、给出使用连接池的Demo；

窗体代码：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 310
  ClientWidth = 682
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 24
    Top = 8
    Width = 138
    Height = 25
    Caption = #20027#32447#27979#35797
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 24
    Top = 55
    Width = 138
    Height = 25
    Caption = #22810#32447#31243#27979#35797
    TabOrder = 1
    OnClick = Button2Click
  end
  object Memo1: TMemo
    Left = 184
    Top = 8
    Width = 490
    Height = 294
    Lines.Strings = (
      'Memo1')
    TabOrder = 2
  end
  object Button3: TButton
    Left = 24
    Top = 96
    Width = 138
    Height = 25
    Caption = #33719#21462#27744'SQL'#36830#25509#23545#35937#20010#25968
    TabOrder = 3
    OnClick = Button3Click
  end
end

实现代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls;


const
  WM_PUSHDATA=WM_USER+100;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    procedure GetDtaTest;
    { Private declarations }
    procedure WMHandlePUSHDATA(var msg:TMessage);message WM_PUSHDATA;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses sqlConPool,uni;

{$R *.dfm}


//开启多个线程测试
procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to 50 do
  begin
    TThread.CreateAnonymousThread(GetDtaTest).Start;
  end;
end;


//显示当前连接池中SQLConnetion对象
procedure TForm1.Button3Click(Sender: TObject);
begin
   ShowMessage(Format('PoolCount=%d',[SQLConnectionPools.PoolCount]));
end;


//通过获取SQL对象，获取数据
procedure TForm1.GetDtaTest();
var
  qry: TUniQuery;
  uid: integer;
  susername, spw: string;
  str:String;
begin
  // 获取对象
  qry := QryPools.Pop;
  try
    with qry do
    begin
      SQL.Text := 'select * from user';
      Open;
      while not eof do
      begin
        uid := FieldByName('id').AsInteger;
        susername := FieldByName('username').AsString;
        spw := FieldByName('password').AsString;

         str:=  Format('id=%d ,username=%s,password=%s',[uid,susername,spw]);

         //因为如果在工作线程中，避免在主线程下操作UI；
         SendTextMessage(self.Handle,WM_PUSHDATA,0,str);

        Next;
      end;
    end;
  finally
    // 回收对象
    QryPools.Push(qry);
  end;
end;


//打印显示获取数据
procedure TForm1.WMHandlePUSHDATA(var msg: TMessage);
var
  str:string;
begin
   str:=String(  msg.LParam );
   Memo1.Lines.Add(str) ;
end;

//主线程下测试
procedure TForm1.Button1Click(Sender: TObject);
begin
  GetDtaTest();
end;

end.

转自https://www.cnblogs.com/oldsheep/p/3788049.html