uconnectionpool.pas

数据库连接池。很重要很好的参考例子。全部源码

    //
    // 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 - 1 do
      if not FConnections[I].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;
  FCS.SetLockName('FCS');
  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.Count do
      begin
        if not FConnections[I].Busy then
        begin
          Result:= FConnections[I].Connection;
          try
            FConnections[I].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.Add do
          begin
            Result:= Connection;
            Lock;
          end;
        end
        else
          raise Exception.Create('Connection pool limit exceeded.');
    except
      On E: Exception do
        DoLockFail(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 - 1 do
      if FConnections[I].Connection = aConnection then
      begin
        FConnections[I].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.