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