Reputation: 141
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
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