That way I do not declare the "TIBCConnection" within the Thread Class however I create the "TIBCConnection" Inside the Thread
And give me an error of "EIBCError" -> "unable to allocate memory from operating system"
The problem is that this is random and I can not reproduce in my machine this problem only happened in some clients where I put a system of Tests.
The link for you to download the Sample Sources is this:
https://mega.nz/#!EjoFWQBb!AOsqz_x3etGZ ... Dg20VjJzUA
in this example I did not put the database you can put any database with a Query that swallows multiple records to be Slow.
Code: Select all
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Vcl.Grids, Vcl.DBGrids,
DBAccess, IBC, MemDS, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
IBCQuery2: TIBCQuery;
DataSource2: TDataSource;
DataSource1: TDataSource;
IBCQuery1: TIBCQuery;
IBCConnection1: TIBCConnection;
DBGrid1: TDBGrid;
DBGrid2: TDBGrid;
Button3: TButton;
Button4: TButton;
IBCConnection2: TIBCConnection;
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Type
TConnectionThread = Class
Public
emUso: Boolean;
fIBConnection: TIBCConnection;
constructor Create;
End;
type
TThreadQuery = class(TThread)
private
IndexConn: Integer;
fQuery: TIBCQuery;
procedure Proc_Termino(Sender: TObject);
protected
procedure Execute; override;
public
fForm: TForm;
constructor Create(aQuery: TIBCQuery; aForm: TForm);
end;
var
Form1: TForm1;
fConnectionThread: TConnectionThread;
FListConnection: TList;
IndexObj: Integer;
StrErroQuery: String;
QuerythrSQL: TThreadQuery;
implementation
{$R *.dfm}
Uses
Unit_TempoCDS;
constructor TConnectionThread.Create;
begin
inherited Create;
fIBConnection := TIBCConnection.Create(Nil);
With fIBConnection, Form1 do Begin
Database := IBCConnection1.Database;
UserName := IBCConnection1.UserName;
Password := IBCConnection1.Password;
SQLDialect := IBCConnection1.SQLDialect;
ClientLibrary := IBCConnection1.ClientLibrary;
Options.Protocol := IBCConnection1.Options.Protocol;
Options.DisconnectedMode := True;
LoginPrompt := False;
Connected := True;
End;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FListConnection := TList.Create;
end;
constructor TThreadQuery.Create(aQuery: TIBCQuery; aForm: TForm);
begin
inherited Create(False);
fQuery := aQuery;
fForm := aForm;
OnTerminate := Proc_Termino;
FreeOnTerminate := True;
end;
Function GetConnectioninThread(Var IndexConn: Integer): TIBCConnection;
Var I: Integer;
Var AchouConnection: Boolean;
Begin
IndexConn := -1;
AchouConnection := False;
For I := 0 to FListConnection.count - 1 do begin
if Not TConnectionThread(FListConnection[I]).emUso Then Begin
AchouConnection := True;
Result := TConnectionThread(FListConnection[I]).fIBConnection;
TConnectionThread(FListConnection[I]).emUso := True;
IndexConn := I;
Break;
End;
End;
if Not AchouConnection Then Begin
fConnectionThread := TConnectionThread.Create; [b]// Error "EIBCError" unable to allocate memory from operating system[/b]
FListConnection.Add(fConnectionThread);
IndexConn := FListConnection.count - 1;
Result := fConnectionThread.fIBConnection;
fConnectionThread.emUso := True;
End;
End;
procedure TThreadQuery.Execute;
Var vSQL: String;
begin
Try
StrErroQuery := EmptyStr;
fQuery.Close;
vSQL := fQuery.Sql.Text;
fQuery.Connection := GetConnectioninThread(IndexConn);
fQuery.Open;
Except
on E: Exception do begin
Raise Exception.Create(E.Message + #13#13 + vSQL);
end;
End;
end;
procedure TThreadQuery.Proc_Termino(Sender: TObject);
Var NameForm: String;
begin
if Assigned(fForm) Then
fForm.Close;
if IndexConn > -1 Then
TConnectionThread(FListConnection[IndexConn]).emUso := False;
QuerythrSQL := Nil;
end;
Function Func_OpenCDS(aQuery: TIBCQuery; Tabela: String): Boolean;
Var vDataSet: TDataSet;
Procedure Proc_ShowProgressTabela;
Begin
Frm_TempoCDS := TFrm_TempoCDS.Create(Nil);
Frm_TempoCDS.Lb_Mensagem.Caption := Tabela;
Frm_TempoCDS.Lb_Mensagem.Update;
Frm_TempoCDS.Show;
Frm_TempoCDS.Update;
QuerythrSQL := TThreadQuery.Create(aQuery, Frm_TempoCDS);
While (Assigned(QuerythrSQL)) And (Not QuerythrSQL.Terminated) do
Application.ProcessMessages;
End;
Begin
aQuery.DisableControls;
Proc_ShowProgressTabela;
aQuery.EnableControls;
End;
procedure TForm1.Button3Click(Sender: TObject);
begin
Button3.Enabled := False;
Func_OpenCDS(IBCQuery1, 'Query A');
Button3.Enabled := True;
end;