基于UniDac的数据库连接池

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

 

 

 

 

 

 

 

 

posted @ 2014-06-15 10:38  发烧践行者  阅读(4040)  评论(3编辑  收藏  举报