Hi André!
Thank you for contacting Devart and for your inquiry!
We do apologize for the slight delay in our response! We carefully examined your sample and came to the following results:
The sample you sent does not demonstrate the bug you specified in the work of our pulling. The reason for this filling of ListBoxes is in the order of thread starts.
If you display in the ListBox not only information that the connection is open, but also information about the start of the thread, you will see that the threads from the second cycle are launched 1-2 seconds later than the first, respectively, and connections are first opened in the first cycle and with some delay in the second.
You can use your example code slightly modified by us.
Code: Select all
procedure TForm1.Button1Click(Sender: TObject);
var
LPooling: string;
begin
Button1.Enabled := False;
Button1.Caption := 'Running..';
TTask.Run(
procedure
var
LIndex: Integer;
LStopWatch: TStopWatch;
LTasks: TArray<ITask>;
LConnection: TUniConnection;
begin
LConnection := TUniConnection.Create(nil);
LConnection.ConnectString := 'Provider Name=mySQL;Database=sakila;User ID=admin;Password=Teste_1234;Connection Timeout=15;Data Source=10.211.55.13;Port=3306';
LConnection.LoginPrompt := False;
LConnection.PoolingOptions.MaxPoolSize := 4;
LConnection.PoolingOptions.MinPoolSize := 4;
LConnection.PoolingOptions.ConnectionLifetime := 5000;
LConnection.PoolingOptions.Validate := True;
LConnection.Pooling := True;
//LConnection.Open;
//LConnection.Close; // Some caching should happen !!!
//LConnection.Open; // Open before timing starts
LStopWatch := TStopWatch.StartNew;
LTasks := [];
for LIndex := 1 to 100 do
begin
LTasks := LTasks + [TTask.Run(
procedure
var
LLConnection: TUniConnection;
LQuery: TUniQuery;
j: Integer;
begin
j := TTask.CurrentTask.Id;
TThread.Synchronize(nil, procedure
begin
listbox1.items.add('Started: ' + IntToStR(j));
listbox1.update;
ListBox1.ItemIndex := ListBox1.Items.Count - 1;
end);
LLConnection := TUniConnection.Create(nil, LConnection.ConnectString);
LLConnection.Open;
try
LQuery := TUniQuery.Create(nil);
try
LQuery.Connection := LLConnection;
LQuery.SQL.Text := 'select * from customer';
TThread.Synchronize(nil, procedure
begin
listbox1.items.add('Connected: ' + IntToStR(j));
listbox1.update;
ListBox1.ItemIndex := ListBox1.Items.Count - 1;
end);
LQuery.Open;
LQuery.Last;
sleep(300);
LQuery.Close;
TThread.Synchronize(nil, procedure
begin
listbox1.items.delete(listbox1.items.IndexOf('Started: ' + IntToStR(j)));
listbox1.items.delete(listbox1.items.IndexOf('Connected: ' + IntToStR(j)));
listbox1.update;
listbox2.ItemIndex := listbox2.Items.Count - 1;
end);
finally
FreeAndNil(LQuery);
end;
finally
LLConnection.Close;
FreeAndNil(LLConnection);
end;
end)];
end;
TTask.WaitForAll(LTasks);
LConnection.Close;
FreeAndNil(LConnection);
LStopWatch.Stop;
TThread.Synchronize(nil,
procedure
begin
Memo1.Lines.Add('MYSQL 1 - '+LPooling + LStopWatch.Elapsed.ToString());
end);
end);
TTask.Run(
procedure
var
LIndex: Integer;
LStopWatch: TStopWatch;
LTasks: TArray<ITask>;
LConnection: TUniConnection;
begin
LConnection := TUniConnection.Create(nil);
LConnection.ConnectString := 'Provider Name=mySQL;Database=sakila;User ID=admin;Password=Teste_1234;Connection Timeout=15;Data Source=10.211.55.13;Port=3306';
LConnection.LoginPrompt := False;
LConnection.PoolingOptions.MaxPoolSize := 4;
LConnection.PoolingOptions.MinPoolSize := 4;
//DIFFERENT VALUE, NEW CONNECTION POOL USED
LConnection.PoolingOptions.ConnectionLifetime := 6000;
LConnection.PoolingOptions.Validate := True;
LConnection.Pooling := True;
//LConnection.Open;
//LConnection.Close; // Some caching should happen !!!
//LConnection.Open; // Open before timing starts
LStopWatch := TStopWatch.StartNew;
LTasks := [];
for LIndex := 1 to 100 do
begin
LTasks := LTasks + [TTask.Run(
procedure
var
LLConnection: TUniConnection;
LQuery: TUniQuery;
j: Integer;
begin
j := TTask.CurrentTask.Id;
TThread.Synchronize(nil, procedure
begin
listbox2.items.add('Started: ' + IntToStR(j));
listbox2.update;
listbox2.ItemIndex := listbox2.Items.Count - 1;
end);
LLConnection := TUniConnection.Create(nil, LConnection.ConnectString);
LLConnection.Open;
try
LQuery := TUniQuery.Create(nil);
try
LQuery.Connection := LLConnection;
LQuery.SQL.Text := 'select * from customer';
TThread.Synchronize(nil, procedure
begin
listbox2.items.add('Connected: ' + IntToStR(j));
listbox2.update;
listbox2.ItemIndex := listbox2.Items.Count - 1;
end);
LQuery.Open;
LQuery.Last;
sleep(300);
LQuery.Close;
TThread.Synchronize(nil, procedure
begin
listbox2.items.delete(listbox2.items.IndexOf('Started: ' + IntToStR(j)));
listbox2.items.delete(listbox2.items.IndexOf('Connected: ' + IntToStR(j)));
listbox2.update;
listbox2.ItemIndex := listbox2.Items.Count - 1;
end);
finally
FreeAndNil(LQuery);
end;
finally
LLConnection.Close;
FreeAndNil(LLConnection);
end;
end)];
end;
TTask.WaitForAll(LTasks);
LConnection.Close;
FreeAndNil(LConnection);
LStopWatch.Stop;
TThread.Synchronize(nil,
procedure
begin
Memo1.Lines.Add('MYSQL 2 - '+LPooling + LStopWatch.Elapsed.ToString());
end);
end);
end;
Then you will see that there are times when 4 connections are open in both the first and second threads at the same time (see screenshot).
Also, you can use the TUniSQLMonitor component to get information about the work of our connection pools. To do this, just place this component on the form and set tfPool in the TraceFlag enumeration (see screenshot).
Then you should launch TUniSQLMonitor, for this you just need to click on it twice, and then launch your application and click Button1. You will see identical and correct behavior for both pools.
We will consider the possibility of adding Id to PoolingOptions so that to create two independent pools you do not have to look for wordaround of job type of different ConnectionLifetime.
Please, let us know if you have any questions!
Thanks in advance,
Viktor