unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FIBDatabase, pFIBDatabase, IBConnectionBroker, IBDatabase, DB,
  FIBDataSet, pFIBDataSet, Grids, DBGrids, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    db: TpFIBDatabase;
    dt: TpFIBDataSet;
    DBGrid1: TDBGrid;
    Panel1: TPanel;
    Panel2: TPanel;
    lblAvailable: TLabel;
    lblAllocated: TLabel;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    lbl1: TLabel;
    lbl2: TLabel;
    Memo1: TMemo;
    DataSource1: TDataSource;
    StatusBar1: TStatusBar;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    procedure OnConnectionBrokerLog(Sender: TObject; LogMessage: String);
  public

  end;

var
  Form1: TForm1;

implementation

uses
  FIBConnectionBroker,
  FIBQuery,
  pFIBQuery, uCommon;

{$R *.dfm}

const
  MaxConn = 30;

var
  FConnBroker: TFIBConnectionBroker;
  Threads : Array[1..MaxConn] of TThread;

type
{ Important:
    Methods and properties of objects in VCL or CLX can only be
    used in a method called using Synchronize, for example,
      Synchronize(UpdateCaption);
    and UpdateCaption could look like,
    procedure TTestthread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
  TTestthread = class(TThread)
  protected
    qsql : TFIBQuery;
    procedure Execute; override;
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo2.Text := GetExampleNotes;
  Caption := 'FIBPlus Example - ' + Application.Title;
  db.DBName := 'localhost:' + ExtractFileDir(Application.ExeName) + '\db\employee.fdb';

  Memo1.Lines.Clear;
  FConnBroker := TFIBConnectionBroker.Create(Self);
  FConnBroker.DatabaseName := db.DBName;
  FConnBroker.DBParams   := db.DBParams;
  FConnBroker.MinConnections := 10;
  FConnBroker.MaxConnections := 20;
  FConnBroker.OnLog := OnConnectionBrokerLog;
  FConnBroker.Init;

  dt.Database := FConnBroker.GetConnection;
  dt.Transaction := dt.Database.DefaultTransaction;
  dt.SelectSQL.Text := 'select * from employee';
  dt.Open;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  dt.Close;
  FConnBroker.Free;
end;

{ TTestthread }

procedure TTestthread.Execute;
var d : TFIBDatabase;
begin
  d := nil;
  qsql := TFIBQuery.Create(nil);
  { Place thread code here }
  while not Terminated do begin
    while not Assigned(d) do
      d := FConnBroker.GetConnection;
    qsql.Database := d;
    qsql.Transaction := d.DefaultTransaction;
    qsql.Transaction.StartTransaction;
    qsql.SQL.Text := 'select * from employee';
    qsql.ExecQuery;
    while not qsql.Eof do
      qsql.Next;
    Sleep(1000 + Random(5000));
    qsql.Close;
    qsql.SQL.Text := 'select * from customer';
    qsql.ExecQuery;
    while not qsql.Eof do
      qsql.Next;
    qsql.Close;
    qsql.Transaction.Commit;
    qsql.FreeHandle;
    FConnBroker.ReleaseConnection(d);
    d := nil;
    Sleep(1000 + Random(2000));
  end;
  qsql.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  lbl1.Caption := IntToStr(FConnBroker.AvailableConnections);
  lbl2.Caption := IntToStr(FConnBroker.AllocatedConnections);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i : Integer;
begin
  for i := 1 to MaxConn do begin
    Threads[i] := TTestthread.Create(false);
    Threads[i].FreeOnTerminate := true;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i : Integer;
begin
  for i := 1 to MaxConn do begin
    Threads[i].Terminate;
    Threads[i] := nil;
  end;
end;

procedure TForm1.OnConnectionBrokerLog(Sender: TObject;
  LogMessage: String);
begin
  Memo1.Lines.Add(LogMessage);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := MessageDlg('This will end your ' + QuotedStr(Caption) + ' session. Proceed?',
    mtConfirmation, [mbOk, mbCancel], 0) = mrOk;
end;

end.
