Devart UniDAC Connection pooling 2

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, MemDS, DBAccess, Uni,
  Vcl.StdCtrls, Generics.Collections, SyncObjs;

type
  TUniConnectionPooled = class(TUniConnection)
  private
    FInUse: Boolean;
  public
    property InUse: Boolean read FInUse write FInUse;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }

    FPool: TObjectList<TUniConnectionPooled>;
    FInUseCount: Integer;
    FMaxUseCount: Integer;
    FCS: TCriticalSection;

    function GetConnection(): TUniConnection;
    procedure ReturnConnection(const AConn: TUniConnection);
    procedure IncreasePool(const ACount: integer);
    procedure OutputDebug(const AMsg: string);
  public
    { Public declarations }
    property InUseCount: Integer read FInUseCount;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Diagnostics, Threading, InterbaseUniProvider, System.TimeSpan;


procedure SetupConnection(const AUniConn: TUniConnection);
begin
  AUniConn.ProviderName := 'InterBase';
  AUniConn.Server :='localhost';
  AUniConn.Database := 'employee';
  AUniConn.Username := 'SYSDBA';
  AUniConn.Password := 'masterkey';
  AUniConn.LoginPrompt := False;
  AUniConn.PoolingOptions.MaxPoolSize := 10;
  AUniConn.PoolingOptions.MinPoolSize := 2;
  AUniConn.PoolingOptions.ConnectionLifetime := 60000; // 60 seconds
  AUniConn.PoolingOptions.Validate := True;
  AUniConn.Pooling := True;
//  AUniConn.Connect;
end;



procedure TForm1.Button1Click(Sender: TObject);
var
  LIndex: Integer;
  LStopWatch: TStopWatch;
  LTasks: TArray<ITask>;
  LWarmUpConnection: TUniConnection;
begin

  LWarmUpConnection := TUniConnection.Create(nil);
  try
    SetupConnection(LWarmUpConnection);
    LWarmUpConnection.Open;

    LStopWatch := TStopWatch.StartNew;
    LTasks := [];
    for LIndex := 1 to 1000 do
    begin

      LTasks := LTasks + [
        TTask.Run(
          procedure
          var
            LConnection: TUniConnection;
            LQuery: TUniQuery;
          begin
            LConnection := GetConnection();
            try
              LQuery := TUniQuery.Create(nil);
              try
                LQuery.Connection := LConnection;
                LQuery.SQL.Text := 'select * from EMPLOYEE';

                LQuery.Open;
                LQuery.Last;
              finally
                FreeAndNil(LQuery);
              end;
            finally
              ReturnConnection(LConnection);
            end;
          end
        )
      ];

    end;

    while not TTask.WaitForAll(LTasks, TTimeSpan.FromSeconds(1)) do
    begin
      Application.ProcessMessages;
    end;

    LStopWatch.Stop;
    Button1.Caption := LStopWatch.ElapsedMilliseconds.ToString;
  finally
    LWarmUpConnection.Close;
    FreeAndNil(LWarmUpConnection);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FCS := TCriticalSection.Create;
  FPool := TObjectList<TUniConnectionPooled>.Create;
  FInUseCount := 0;
  FMaxUseCount := 0;
  IncreasePool(100);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FCS.Enter;
  try
    FreeAndNil(FPool);
  finally
    FCS.Leave;
  end;

  FreeAndNil(FCS);
end;

function TForm1.GetConnection: TUniConnection;
var
  LConnection: TUniConnectionPooled;
begin
  FCS.Enter;
  try
    Result := nil;
    for LConnection in FPool do
     if not LConnection.InUse then
     begin
       LConnection.InUse := True;
       Result := LConnection;
       Inc(FInUseCount);
       if FInUseCount > FMaxUseCount then
         FMaxUseCount := FInUseCount;

       OutputDebug('In use: ' + FInUseCount.ToString + ' Max: ' + FMaxUseCount.ToString);
       Exit;
     end;
  finally
    FCS.Leave;
  end;
end;

procedure TForm1.IncreasePool(const ACount: integer);
var
  LIndex: Integer;
  LUniConnection: TUniConnectionPooled;
begin
  FCS.Enter;
  try
    for LIndex := 1 to ACount do
    begin
      LUniConnection := TUniConnectionPooled.Create(nil);
      try
        SetupConnection(LUniConnection);
        FPool.Add(LUniConnection);
      except
        LUniConnection.Free;
        raise;
      end;
    end;
  finally
    FCS.Leave;
  end;
end;

procedure TForm1.OutputDebug(const AMsg: string);
begin
  TThread.Queue(nil
  , procedure
    begin
      Label1.Caption := AMsg;
      Label1.Update;
      Application.ProcessMessages;
    end
  );
end;

procedure TForm1.ReturnConnection(const AConn: TUniConnection);
var
  LIndex: Integer;
  LConn: TUniConnectionPooled;
begin
  FCS.Enter;
  try
    LConn := AConn as TUniConnectionPooled;
    LIndex := FPool.IndexOf(LConn);
    if LIndex <> -1 then
    begin
      FPool[LIndex].InUse := False;
      Dec(FInUseCount);
    end;
  finally
    FCS.Leave;
  end;
end;

end.