////////////////////////////////////////////////////////////////////////////////
//
// The uConnectionPool unit contains base classes of Connection Pool.
//
unit uConnectionPool;
interface
uses
Classes, DB, SyncObjs, SysUtils;
type
TPoolConnectionClass = class of TPoolConnection;
TCustomConnectionPool = class;
//////////////////////////////////////////////////////////////////////////////
//
// Summary:
// TPoolConnection represents a connection in a connection pool
// (TCustomConnectionPool).
//
// Description:
// Each TCustomConnectionPool uses a TPoolConnections to maintain a
// collection of TPoolConnection objects. Each TPoolConnection object
// represents the single database connection in the pool.
//
TPoolConnection = class(TCollectionItem)
private
FBusy: Boolean;
FConnection: TCustomConnection;
protected
//
// Summary:
// Locks the connection in the connection pool
//
// Description:
// Lock mark connection as "locked"
and opens connection if it closed.
//
// SeeAlso:
// Busy, TCustomConnectionPool.GetConnection
//
procedure Lock;
virtual;
//
// Summary:
// Unlocks the connection in the connection pool
//
// Description:
// Unlock mark connection as "unlocked". Unlocked connection can be
// retreived by calling TCustomConnectionPool.GetConnection
//
// SeeAlso:
// Busy, TCustomConnectionPool.FreeConnection
//
procedure Unlock;
virtual;
//
// Summary:
// Connected checks database connection
//
// Result:
// True - if connection connected to database
// False - otherwise
//
// SeeAlso:
// Connection
//
function Connected: Boolean;
virtual;
//
// Summary:
// CreateConnection creates connection element
//
// Result:
// Newly created TCustomConnection descendant
//
// SeeAlso:
// Connection
//
function CreateConnection: TCustomConnection;
virtual;
abstract;
public
//
// Summary:
// Indicates that the connection has been locked.
//
// Description:
// Busy is a Boolean property that indicates when the connection has been
// locked.
//
// SeeAlso:
// Lock, Unlock
//
property Busy: Boolean read FBusy;
//
// Summary:
// Contains TCustomConnection descendants represented by this connection
// pool item.
//
// SeeAlso:
// TCustomConnectionPool.GetConnection,
// TCustomConnectionPool.FreeConnection
//
property Connection: TCustomConnection read FConnection;
//
// Summary:
// Creates and initializes a TPoolConnection instance.
//
// Description:
// The Create method takes as a parameter the name of a TCollection
// instance. Create is called by TPoolConnection抯 Add method.
//
// SeeAlso:
// TPoolConnections.Add
//
constructor Create(aCollection: TCollection);
override;
//
// Summary:
// Destroys the TPoolConnection instance and frees its memory.
//
// Description:
// Destroy is called indirectly by TCollection抯 Clear method.
//
// SeeAlso:
// TCollection.Clear
//
destructor Destroy;
override;
end;
//////////////////////////////////////////////////////////////////////////////
//
// Summary:
// TPoolConnections is a container for TPoolConnection objects.
//
// Description:
// Each TPoolConnections holds a collection of TPoolConnection objects in a
// connection pool (TCustomConnectionPool). TPoolConnections maintains an
// index of the connection in its Items array. The Count property contains
// the number of connections in the collection.
//
// SeeAlso:
// TCustomConnectionPool, TPoolConnection
//
TPoolConnections = class(TOwnedCollection)
private
function GetItem(aIndex: Integer): TPoolConnection;
procedure SetItem(aIndex: Integer;
const Value: TPoolConnection);
public
//
// Summary:
// Provides indexed access to the items in the collection.
//
// Description:
// Use Items to access individual items in the collection. The value of
// the Index parameter corresponds to the Index property of
// TPoolConnection. It represents the position of the item in the
// collection.
//
property Items[aIndex: LongInt]: TPoolConnection read GetItem write SetItem;
default;
//
// Summary:
// Creates a new TPoolConnection instance and adds it to the Items array.
//
// Description:
// Call Add to create an item in the collection. The new item is placed at
// the end of the Items array.
//
// Result:
// Add returns the new collection item.
//
function Add: TPoolConnection;
{$IFNDEF VER140}
//
// Summary:
// Returns the Owner of the collection.
//
// Description:
// Call Owner to obtain a reference to the object that owns this
// collection. Typically, the owner uses the collection to implement one
// of its properties.
//
function Owner: TPersistent;
{$ENDIF}
end;
TExceptionEvent = procedure (Sender: TObject;
E: Exception) of object;
//////////////////////////////////////////////////////////////////////////////
//
// Summary:
// TCustomConnection is the base class for components that represents a pool
// of connections to one database.
//
// Description:
// Use TCustomConnection as a base class for components that represent a
// poolof connections to one database.do
not create instances of
// TCustomConnectionPool. To add a component that represents the connection
// pool, use a TCustomConnectionPool descendant such as TBDEConnectioPool,
// TADOConnectionPool, TDBXConnectionPool.
//
// SeeAlso:
// TBDEConnectioPool, TADOConnectionPool, TDBXConnectionPool.
//
TCustomConnectionPool = class(TComponent)
private
FCS: TCriticalSection;
FConnections: TPoolConnections;
FMaxConnections: LongInt;
FOnLockConnection: TNotifyEvent;
FOnLockFail: TExceptionEvent;
FOnUnLockConnection: TNotifyEvent;
FOnCreateConnection: TNotifyEvent;
FOnFreeConnection: TNotifyEvent;
function GetUnusedConnections: LongInt;
function GetTotalConnections: LongInt;
protected
//
// Summary:
// Returns class of items into pool collection.
//
// Description:
// TCustomConnectionPool descendants overrides GetPoolItemClass for
// declaring class of items in the pool collection.
//
// Result:
// Class of items into pool collection.
//
function GetPoolItemClass: TPoolConnectionClass;
virtual;
abstract;
//
// Summary:
// Generates an OnLock event.
//
// Description:
// do
Lock is called automatically when connection locked. Override this
// method to provide additional processing other than calling the OnLock
// event handler.
//
// SeeAlso:
// OnLock, TPoolConnection.Lock
//
proceduredo
Lock;
virtual;
//
// Summary:
// Generates an OnLockFail event.
//
// Description:
// do
LockFail is called automatically when connection locking
// failed (Connection limit exceeded or any other error raised).
// Override this method to provide additional processing other than
// calling the OnLockFail event handler.
//
// SeeAlso:
// OnLockConnection, OnLockFail
//
proceduredo
LockFail(E: Exception);
virtual;
//
// Summary:
// Generates an OnUnlock event.
//
// Description:
// do
Unlock is called automatically when connection unlocked. Override
// this method to provide additional processing other than calling the
// OnUnlock event handler.
//
// SeeAlso:
// OnUnlock, TPoolConnection.Unlock
//
proceduredo
Unlock;
virtual;
//
// Summary:
// Generates an OnCreateConnection event.
//
// Description:
// do
CreateConnection is called automatically when new connection
// allocated. Override this method to provide additional processing other
// than calling the OnCreateConnection event handler.
//
// SeeAlso:
// OnCreateConnection
//
proceduredo
CreateConnection;
virtual;
//
// Summary:
// Generates an OnFreeConnection event.
//
// Description:
// OnFreeConnection is called automatically when connection destroyed
// Override this method to provide additional processing other than
// calling the OnCreateConnection event handler.
//
// SeeAlso:
// OnFreeConnection
//
proceduredo
FreeConnection;
virtual;
public
constructor Create(aOwner: TComponent);
override;
destructor Destroy;
override;
// Summary:
// Copies the contents of another ConnectionPool or Connection.
//
// Description:
// Call Assign to copy the properties of Connection Pool from another
// ConnectionPool or Connection. The standard form of a call to Assign is
// <CODE>
// Destination.Assign(Source);
// </CODE>
procedure AssignTo(Dest: TPersistent);
override;
//
// Summary:
// MaxConnections reprsents the max. number of connections in the pool.
//
// Description
// MaxConnections property is used to set the number of concurrent
// connections the connection pool will make to the database.
// If MaxConnections = -1, then
number of connections is unlimited.
//
// SeeAlso:
// GetConnection
//
property MaxConnections: LongInt read FMaxConnections write FMaxConnections default -1;
//
// Summary:
// Retreives connection from the pool.
//
// Description:
// GetConnection looks into connections list for unlocked connection.
// If none found and number of connections less than MaxConnections, then
// new connection is allocated.
//
// Result:
// Returns pooled connection.
//
// SeeAlso:
// FreeConnection, MaxConnections.
//
function GetConnection: TCustomConnection;
//
// Summary:
// Returns connection into the pool.
//
// Description:
// FreeConnection calls Unlock method of the TPoolConnection
//
// Parameters:
// aConnection - freed connection.
//
// SeeAlso:
// GetConnection
//
procedure FreeConnection(aConnection: TCustomConnection);
//
// Summary:
// Returns number of unused connections in the pool.
//
// Description:
// Use UnusedConnections for calculating number of allocated and not used
// connections.
//
property UnusedConnections: LongInt read GetUnusedConnections;
//
// Summary:
// Returns number of allocated connections in the pool.
//
// Description:
// Use TotalConnections for retrieving number of allocated connections in
// the pool.
//
property TotalConnections: LongInt read GetTotalConnections;
//
// Summary:
// Occurs when a connection into pool is locked.
//
// Description:
// Write an OnLockConnection event handler to take application-specific
// actions immediately after the connection pool component locks a
// connection.
//
property OnLockConnection: TNotifyEvent read FOnLockConnection write FOnLockConnection;
//
// Summary:
// Occurs when a connection into pool is unlocked.
//
// Description:
// Write an OnUnlockConnection event handler to take application-specific
// actions immediately after the connection pool component unlocks a
// connection.
//
property OnUnlockConnection: TNotifyEvent read FOnUnlockConnection write FOnUnlockConnection;
//
// Summary:
// Occurs when a connection pool allocates new connection.
//
// Description:
// Write an OnCreateConnection event handler to take application-specific
// actions immediately after the new connection into pool is allocated.
//
property OnCreateConnection: TNotifyEvent read FOnCreateConnection write FOnCreateConnection;
//
// Summary:
// Occurs when locking a connection into pool is failed.
//
// Description:
// Write an OnLockFail event handler to take application-specific
// actions immediately after the locking connection into pool is failed.
//
property OnLockFail: TExceptionEvent read FOnLockFail write FOnLockFail;
//
// Summary:
// Occurs when a connection pool frees connection.
//
// Description:
// Write an OnFreeConnection event handler to take application-specific
// actions immediately after the connection into pool is freed.
//
property OnFreeConnection: TNotifyEvent read FOnFreeConnection write FOnFreeConnection;
end;
implementation
{$IFDEF TRIAL}
uses
Windows;
{$ENDIF}
{ TPoolConnection }
{- protected ----------------------------------------------------------------- }
procedure TPoolConnection.Lock;
begin
FBusy:= true;
if not Connected then
Connection.Open;
TCustomConnectionPool(TPoolConnections(Collection).Owner).DoLock;
end;
procedure TPoolConnection.Unlock;
begin
FBusy:= false;
TCustomConnectionPool(TPoolConnections(Collection).Owner).DoUnLock;
end;
function TPoolConnection.Connected: Boolean;
begin
Result:= Connection.Connected;
end;
{ - public ------------------------------------------------------------------- }
constructor TPoolConnection.Create(aCollection: TCollection);
begin
inherited;
FConnection:= CreateConnection;
TCustomConnectionPool(TPoolConnections(Collection).Owner).DoCreateConnection;
end;
destructor TPoolConnection.Destroy;
begin
if Busy then
Unlock;
FreeAndNil(FConnection);
TCustomConnectionPool(TPoolConnections(Collection).Owner).DoFreeConnection;
inherited;
end;
{ TPoolConnections }
{ - private ------------------------------------------------------------------ }
function TPoolConnections.GetItem(aIndex: Integer): TPoolConnection;
begin
Result:= inherited GetItem(aIndex) as TPoolConnection;
end;
procedure TPoolConnections.SetItem(aIndex: Integer;
const Value: TPoolConnection);
begin
inherited SetItem(aIndex, Value);
end;
{ - public ------------------------------------------------------------------- }
function TPoolConnections.Add: TPoolConnection;
begin
Result:= inherited Add as TPoolConnection;
end;
{$IFNDEF VER140}
function TPoolConnections.Owner: TPersistent;
begin
Result:= GetOwner;
end;
{$ENDIF}
{ TCustomConnectionPool }
{ - private ------------------------------------------------------------------ }
function TCustomConnectionPool.GetUnusedConnections: LongInt;
var
I: LongInt;
begin
FCS.Enter;
Result:= 0;
try
for I:= 0 to FConnections.Count - 1do
if not FConnections.Busy then
Inc(Result);
finally
FCS.Leave;
end;
end;
function TCustomConnectionPool.GetTotalConnections: LongInt;
begin
Result:= FConnections.Count;
end;
{ - public ------------------------------------------------------------------- }
constructor TCustomConnectionPool.Create(aOwner: TComponent);
begin
inherited;
FCS:= TCriticalSection.Create;
FConnections:= TPoolConnections.Create(Self, GetPoolItemClass);
FMaxConnections:= -1;
end;
destructor TCustomConnectionPool.Destroy;
begin
FCS.Enter;
try
FConnections.Free;
// FreeAndNil(FConnections);
finally
FCS.Leave;
end;
FreeAndNil(FCS);
inherited;
end;
procedure TCustomConnectionPool.AssignTo(Dest: TPersistent);
begin
if Dest is TCustomConnectionPool then
TCustomConnectionPool(Dest).MaxConnections:= MaxConnections
else
inherited AssignTo(Dest);
end;
function TCustomConnectionPool.GetConnection: TCustomConnection;
var
I: LongInt;
begin
Result:= nil;
FCS.Enter;
try
try
I:= 0;
while I < FConnections.Countdo
begin
if not FConnections.Busy then
begin
Result:= FConnections.Connection;
try
FConnections.Lock;
Break;
except
FConnections.Delete(I);
Continue;
end;
end;
Inc(I);
end;
if Result = nil then
if ((FConnections.Count < MaxConnections) or (MaxConnections = -1))
{$IFDEF TRIAL}
and ((FindWindow('TAppBuilder', nil) <> 0) or (FConnections.Count < 3))
{$ENDIF}
then
begin
with FConnections.Adddo
begin
Result:= Connection;
Lock;
end;
end
else
raise Exception.Create('Connection pool limit exceeded.');
except
On E: Exceptiondo
do
LockFail(E);
end;
finally
FCS.Leave;
end;
end;
procedure TCustomConnectionPool.FreeConnection(aConnection: TCustomConnection);
var
I: LongInt;
begin
FCS.Enter;
try
for I:= 0 to FConnections.Count - 1do
if FConnections.Connection = aConnection then
begin
FConnections.Unlock;
Break;
end;
finally
FCS.Leave;
end;
end;
procedure TCustomConnectionPool.DoLock;
begin
if Assigned(FOnLockConnection) then
FOnLockConnection(Self);
end;
procedure TCustomConnectionPool.DoUnlock;
begin
if Assigned(FOnUnLockConnection) then
FOnUnLockConnection(Self);
end;
procedure TCustomConnectionPool.DoCreateConnection;
begin
if Assigned(FOnCreateConnection) then
FOnCreateConnection(Self);
end;
procedure TCustomConnectionPool.DoLockFail(E: Exception);
begin
if Assigned(FOnLockFail) then
FOnLockFail(Self, E);
end;
procedure TCustomConnectionPool.DoFreeConnection;
begin
if Assigned(FOnFreeConnection) then
FOnFreeConnection(Self);
end;
end.
][
][8D][
][