Diego_F
Diego_F

Reputation: 141

What is the right way to use a FDQuery and a Connection Pool in a multitasking application?

I'm trying to use a TFDQuery in a multitasking application, but I'm getting an Acess Violation when opening a FDQuery in both tasks at the same time.

Both here, here, here, here and in the documentation

It is said that the right way to do so is using a Connection Pool.

In a minimun, reproducible example my .dfm is like this

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 393
  ClientWidth = 607
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object BitBtn1: TBitBtn
    Left = 320
    Top = 32
    Width = 121
    Height = 49
    Caption = 'Start Both Tasks'
    TabOrder = 0
    OnClick = BitBtn1Click
  end
  object MemoTh1: TMemo
    Left = 16
    Top = 120
    Width = 257
    Height = 249
    TabOrder = 1
  end
  object MemoTh2: TMemo
    Left = 320
    Top = 120
    Width = 257
    Height = 249
    TabOrder = 2
  end
  object MaskEdit1: TMaskEdit
    Left = 16
    Top = 46
    Width = 153
    Height = 21
    EditMask = '!90:00;1;_'
    MaxLength = 5
    TabOrder = 3
    Text = '  :  '
  end
  object BitBtn2: TBitBtn
    Left = 447
    Top = 32
    Width = 121
    Height = 49
    Caption = 'Cancel Both Tasks'
    TabOrder = 4
    OnClick = BitBtn2Click
  end
  object BitBtn3: TBitBtn
    Left = 198
    Top = 32
    Width = 107
    Height = 49
    Caption = 'Create Connection'
    TabOrder = 5
    OnClick = BitBtn3Click
  end
end

And my .pas is like this

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf,
  FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async,FireDAC.Phys,
  FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
  FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDac.Phys.MySQLDef, FireDac.Phys.MySQL,
  FireDac.Phys.SQLiteDef, System.DateUtils, FireDAC.Phys.SQLite, Vcl.StdCtrls,
  Vcl.Buttons, Vcl.Mask, System.Threading;

type
  TForm2 = class(TForm)
    BitBtn1: TBitBtn;
    MemoTh1: TMemo;
    MemoTh2: TMemo;
    MaskEdit1: TMaskEdit;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    FDManager:TFDManager;
    FDriverMySQL:TFDPhysMySQLDriverLink;
    FDriverSQLite:TFDPhysSQLiteDriverLink;
    Log1, Log2 : TStrings;
    Ts1, Ts2: ITask;
    function  CreateQuery: TFDQuery;
    procedure CreatePooledConnection;
    procedure Test1;
    procedure Test2;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.BitBtn1Click(Sender: TObject);
begin
  Ts1 := TTask.Create(procedure
                      begin
                        Test1;
                      end);
  Ts1.Start;
  Ts2 := TTask.Create(procedure
                      begin
                        Test2;
                      end);
  Ts2.Start;
end;

procedure TForm2.BitBtn2Click(Sender: TObject);
begin
  if(Assigned(Ts1))then
    Ts1.Cancel;;
  if(Assigned(Ts2))then
    Ts2.Cancel;
  while((Ts1.Status <> TTaskStatus.Canceled)and(Ts1.Status<>TTaskStatus.Completed)and(Ts1.Status<>TTaskStatus.Exception))do
    Sleep(1);

  while((Ts2.Status <> TTaskStatus.Canceled)and(Ts2.Status<>TTaskStatus.Completed)and(Ts2.Status<>TTaskStatus.Exception))do
    Sleep(1);
  MemoTh1.Text := Log1.Text;
  MemoTh2.Text := Log2.Text;
end;

procedure TForm2.BitBtn3Click(Sender: TObject);
begin
  CreatePooledConnection;
end;

procedure TForm2.Test1;
var
  fQuery : TFDQuery;
  HoraS: String;
begin
  HoraS := FormatDateTime('hh:nn', TimeOf(NOW));
  while(HoraS<>MaskEdit1.Text)do
  begin
    Sleep(10000);
    HoraS := FormatDateTime('hh:nn', TimeOf(NOW));
  end;
  begin
    try
      Log1.Add('Creating TFDQuery');
      fQuery := CreateQuery;
      try
        Log1.Add('Adding SQL in TFDQuery');
        fQuery.SQL.Clear;
        fQuery.SQL.Add('SELECT id FROM table_two');
        fQuery.SQL.Add('WHERE delete_flag IS NULL');
        fQuery.SQL.Add('LIMIT 1');
        Log1.Add('SQL of TFDQuery: ' + fQuery.SQL.Text);
        Log1.Add('Opening TFDQuery');
        fQuery.Open;
        Log1.Add('Result of TFDQuery: ' + fQuery.FieldByName('id').AsString);
      finally
        fQuery.Free;
      end;
    except
      on E:Exception do
      begin
        Log1.Add('Error: ' + E.Message);
      end;
    end;
  end;
end;

procedure TForm2.Test2;
var
  fQuery : TFDQuery;
  TimeSync: String;
begin
  TimeSync := FormatDateTime('hh:nn', TimeOf(NOW));
  while(TimeSync<>MaskEdit1.Text)do
  begin
    Sleep(10000);
    TimeSync := FormatDateTime('hh:nn', TimeOf(NOW));
  end;
  try
    Log2.Add('Creating TFDQuery');
    fQuery := CreateQuery;
    try
      Log2.Add('Adding SQL in TFDQuery');
      fQuery.SQL.Clear;
      fQuery.SQL.Add('SELECT id FROM table_one');
      fQuery.SQL.Add('WHERE delete_flag IS NULL');
      fQuery.SQL.Add('LIMIT 1');
      Log2.Add('SQL of TFDQuery: ' + fQuery.SQL.Text);
      Log2.Add('Opening TFDQuery');
      fQuery.Open;
      Log2.Add('Result of TFDQuery: ' + fQuery.FieldByName('id').AsString);
    finally
      fQuery.Free;
    end;
  except
    on E:Exception do
    begin
      Log2.Add('Error: ' + E.Message);
    end;
  end;

end;

procedure TForm2.CreatePooledConnection;
var
  oParams: TStrings;
  Conn:TStrings;
  Server, Database, UserName, Password: String;
  Port: Integer;
begin
//  Server   := '';
//  Database := '';
//  UserName := '';
//  Password := '';
//  Port     := '';

  oParams := TStringList.Create;
  Conn    := TStringList.Create;
  try
    FDManager.GetConnectionDefNames(Conn);
    if(Conn.IndexOf('Connection')=-1)then
    begin
      oParams.Add('Server='+Server);
      oParams.Add('Database='+Database);
      oParams.Add('User_Name='+UserName);
      oParams.Add('Password='+Password);
      oParams.Add('Port='+IntToStr(Port));
      oParams.Add('DriverName='+FDriverMySQL.Name);
      oParams.Add('Pooled=True');
      FDManager.AddConnectionDef('Connection', 'MySQL', oParams, True);
      FDManager.Open;
    end;
  finally
    oParams.Free;
    Conn.Free;
  end;

end;

function TForm2.CreateQuery: TFDQuery;
begin
  Result := TFDQuery.Create(nil);
  Result.FetchOptions.Mode := fmAll;
  Result.FetchOptions.RecordCountMode := cmFetched;
  CreatePooledConnection;
  Result.ConnectionName := 'Connection';
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Log1.Free;
  Log2.Free;
  FDManager.Free;
  FDriverMySQL.Free;
  FDriverSQLite.Free;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Log1 := TStringList.Create;
  Log2 := TStringList.Create;

  FDManager := TFDManager.Create(nil);
  FDManager.ResourceOptions.AutoReconnect := True;
  FDriverMySQL := TFDPhysMySQLDriverLink.Create(nil);
  FDriverSQLite := TFDPhysSQLiteDriverLink.Create(nil);
end;

end.

Upvotes: 0

Views: 988

Answers (1)

Rob Lambden
Rob Lambden

Reputation: 2293

I regularly have multiple threads running separate tasks over a shared TFDConnection without problems. I have never used the Connection Pool (but in my own code I may effectively be doing the equivalent).

You cannot expect to access any of the VCL components in a TThread - which is what TTask derives from. You must use the Synchronize method for this.

In general when using threads you are best advised to ensure that separate threads are consistently used with the objects you are creating. In particular accessing any of the VCL objects is unsafe from any thread except the main GUI thread (which is what the Synchronize method is for).

One of the key things I do is ensure that only one thread is accessing the TFDConnection at a time which may be what the connection pool is supposed to be doing for you.

Another issue which meany people run into is creating and deleting TComponent based objects in a TThread. While this can be fine, the way the construction and destruction of TComponents works can result in notifications to other TComponents which it may not be safe to access in your thread.

Protect any shared data with a Mutex of some sort (for example TCriticalSection), ensure you use Synchronize for any VCL component access, and make sure it's clear which thread owns which objects as required.

Upvotes: 1

Related Questions