Database Connection Pool

// Writen by yongnan Studio (Chen XinGuang) 11:58:17
// Database connection pool
// Use the ADO engine and support access, sqlserver, and Oracle databases
// Connection object. Tag = positive number indicates that the connection object is not in use; otherwise, vice versa
// All time units are seconds

Unit udataconnpool;
{$ Hints off}
{$ Warnings off}
Interface

Uses
Sysutils, classes, DB, ADODB, contnrs, windows, extctrls;

// Constant definition
Const
C_ SQL = 'sqlodb ';
C_access = 'Microsoft. Jet. oledb.4.0 ';
C_oracle = 'msdaora. 1 ';

// Custom data type
Type
Tdbtype = (access, sqlserver, Oracle); // supported database types

Rconnparameter = record // parameter structure of the Connection Pool
Connmin: integer; // the minimum number of connection objects to be retained in the connection pool
Connmax: integer; // maximum number of connection objects that can be owned by the connection pool
Timeout: integer; // The timeout value of the object that is not in use
Timeout2: integer; // timeout value of the connected object in use
Refreshtime: integer; // The time when the connection pool is regularly polling.
Dbsource: string; // Data Source
DB: string; // initial catalog specific to SQL Server
Dbuser: string; // user ID
Dbpass: string; // Password
Dbpass2: string; // access-specific Database Password
End;

Tdataconnectionpool = Class (tcomponent) // database connection pool class
Private
Fconnparameter: rconnparameter; // connection pool Parameters
Fconnlist: tcomponentlist; // connection pool container
Fcleantimer: ttimer; // periodically poll the connection pool
Fdbtype: tdbtype; // Database Type
Procedure fcleanontime (Sender: tobject); // periodically poll the connection pool
Function fcreateadoconn: tadoconnection; // create a connection object
Procedure fclean; // process the poll connection pool action
{Private Declarations}
Protected
Function getconncount: integer; // gets the total number of connection objects in the connection pool.
Public
{Public declarations}
Property conncount: integer read getconncount; // total number of connection objects in the connection pool
Constructor create (owner: tcomponent; connparam: rconnparameter; dbtype: tdbtype); // creator Method
// Owner -- owner
// Connparam -- connection pool Parameters
// Dbtype -- supported database types
Function getconn: tadoconnection; // retrieves a non-active connection object from the connection pool.
Procedure returnconn (Conn: tadoconnection); // return the used connection object to the connection pool.
End;

Implementation

Constructor tdataconnectionpool. Create (owner: tcomponent; connparam: rconnparameter; dbtype: tdbtype );
// Owner -- owner
// Connparam -- connection pool Parameters
// Dbtype -- supported database types
VaR
Index: integer;
Begin
Inherited create (owner );
Fdbtype: = dbtype;
Fconnparameter: = connparam;

If fconnlist = nil then
Begin
Fconnlist: = tcomponentlist. Create; // create a connection pool container
For index: = 1 to fconnparameter. connmin do // create a connection object
Fconnlist. Add (fcreateadoconn );
End;

If fcleantimer = nil then // periodically poll the connection pool
Begin
Fcleantimer: = ttimer. Create (Self );
Fcleantimer. Name: = 'mycleantimer1 ';
Fcleantimer. interval: = fconnparameter. refreshtime * 1000;
Fcleantimer. ontimer: = fcleanontime;
Fcleantimer. Enabled: = true;
End;
End;

Procedure tdataconnectionpool. fclean;
VaR
Inow: integer;
Index: integer;
Begin
Inow: = gettickcount; // get the current time
For index: = fconnlist. Count-1 downto 0 do // traverse the connection pool
Begin
If tadoconnection (fconnlist [Index]). Tag> 0 then // connection not in use
Begin
If fconnlist. Count> fconnparameter. connmin then // total number of connections in the connection pool> Minimum number of retained connections
Begin
If Inow-tadoconnection (fconnlist [Index]). Tag> fconnparameter. Timeout * 1000 then // timeout
Fconnlist. Delete (INDEX); // release this connection object from the connection pool
End;
End
Else if tadoconnection (fconnlist [Index]). Tag <0 then // connection in use
Begin
If Inow + tadoconnection (fconnlist [Index]). Tag> fconnparameter. timeout2 * 1000 then // timeout
Begin
Fconnlist. Delete (INDEX); // release this connection object from the connection pool
If fconnlist. Count <fconnparameter. connmin then // connection objects in the connection pool <Minimum number of objects retained
Fconnlist. Add (fcreateadoconn); // create a connection object
End;
End
End;
End;

Procedure tdataconnectionpool. fcleanontime (Sender: tobject );
Begin
Fclean;
End;

Function tdataconnectionpool. fcreateadoconn: tadoconnection;
VaR
Conn: tadoconnection;
Begin
Conn: = tadoconnection. Create (Self );
With conn do
Begin
Loginprompt: = false;
Tag: = gettickcount;

Case fdbtype
Sqlserver:
Begin
Provider: = c_ SQL; // connect to SQL Server
Properties ['data source']. Value: = fconnparameter. dbsource;
Properties ['user id']. Value: = fconnparameter. dbuser;
Properties ['Password']. Value: = fconnparameter. dbpass;
Properties ['initial catalog ']. Value: = fconnparameter. dB;
End;

Access:
Begin
Provider: = c_access; // connect to access
Properties ['Jet oledb: Database password']. Value: = fconnparameter. dbpass2;
Properties ['data source']. Value: = fconnparameter. dbsource;
Properties ['user id']. Value: = fconnparameter. dbuser;
Properties ['Password']. Value: = fconnparameter. dbpass;
End;

ORACLE: // connect to Oracle
Begin
Provider: = c_oracle;
Properties ['data source']. Value: = fconnparameter. dbsource;
Properties ['user id']. Value: = fconnparameter. dbuser;
Properties ['Password']. Value: = fconnparameter. dbpass;
End;
End;

Try // try to connect to the database
Connected: = true;
Result: = conn;
Except
Result: = nil;
Raise exception. Create ('connect database fail .');
End;
End;
End;

Function tdataconnectionpool. getconn: tadoconnection; // retrieves unused connection objects from the connection pool.
VaR
Index: integer;
Begin
Result: = nil;
For index: = 0 to fconnlist. Count-1 do // traverse the connection pool
Begin
If tadoconnection (fconnlist [Index]). Tag> 0 then // unused connection object
Begin
Result: = tadoconnection (fconnlist [Index]);
Result. Tag: =-gettickcount; // mark the connection as in use status
Break; // stop the loop after it is found
End;
End;

If (result = nil) and (index <fconnparameter. connmax) Then // if no connection object is available in the connection pool (all used)
Begin
Result: = fcreateadoconn; // create a connection object based on the maximum connection object
Result. Tag: =-gettickcount; // mark as used
Fconnlist. Add (result); // put in the connection pool
End;
End;

Function tdataconnectionpool. getconncount: integer;
Begin
Result: = fconnlist. Count; // returns the total number of connection objects in the current connection pool.
End;

Procedure tdataconnectionpool. returnconn (Conn: tadoconnection );
Begin
If fconnlist. indexof (conn)>-1 then // determine whether the connection object exists in the connection pool.
Conn. Tag: = gettickcount; // mark this connection object as available
End;

End.