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.