上篇提到了在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.