Search code examples
freepascallazaruscodetyphon

SQLTransaction2 : Operation cannot be performed on an active transaction FreePascal - Code Typhon


I would like some help solving this error message.

I am using Code Typhon32 V4.9 on Windows 7 Pro.

I had a project connecting to a firebird database, Single form which works fine- No problems.

I added a 2nd form to be my data entry form linked to another Database in Firebird - I need both databases in one project.

Since adding the 2nd form I am getting the following error when I close code typhon and when I close Form1 while using the debugger: "SQLTransaction2 : Operation cannot be performed on an active transaction"

I have tried numerous of solution found on the internet but can not solve it.

I have a button that open the 2nd from as Follows:

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
frmContributions := TfrmContributions.Create(nil);
  try
frmContributions.ShowModal;
 finally
frmContributions.Free;
end;
end; 

Here is my 2nd form Code:

unit uFirebirdDemo1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, sqldb, IBConnection, pqconnection, db, FileUtil, Forms,
Controls, Graphics, Dialogs, StdCtrls, DBGrids, DbCtrls;

type
TfrmContributions = class(TForm)
btnUpdate: TButton;
btnDeleteProgrammer: TButton;
dsProgrammer: TDatasource;
dbgrdProgrammer: TDBGrid;
dbnavProgrammer: TDBNavigator;
IBConnection2: TIBConnection;
sqlqProgrammer: TSQLQuery;
SQLScript1: TSQLScript;
SQLTransaction2: TSQLTransaction;
procedure btnDeleteProgramClick(Sender: TObject);
procedure btnUpdateClick(Sender: TObject);
procedure btnUpdateProgramsClick(Sender: TObject);
procedure btnDeleteProgrammerClick(Sender: TObject);
procedure dbgrdCombinedTitleClick(Column: TColumn);
procedure dbgrdProgrammerTitleClick(Column: TColumn);
procedure dbgrdProgramsTitleClick(Column: TColumn);
procedure edtSearchChange(Sender: TObject);
procedure Savechanges;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  end;
 var
frmContributions: TfrmContributions;

implementation

{$R *.lfm}

procedure TfrmContributions.btnUpdateClick(Sender: TObject);
begin
sqlqProgrammer.Edit;
sqlqProgrammer.Post;
sqlqProgrammer.ApplyUpdates(1);
SQLTransaction2.CommitRetaining;
end;


procedure TfrmContributions.btnDeleteProgrammerClick(Sender: TObject);
begin
SQLScript1.Script.Text:= 'Delete from Programmer WHERE ID = ' + dbgrdProgrammer.Columns[0].Field.AsString + ';';
SQLScript1.Execute;
SQLTransaction2.CommitRetaining;
sqlqProgrammer.Refresh;
end;

procedure TfrmContributions.dbgrdProgrammerTitleClick(Column: TColumn);
begin
sqlqProgrammer.Close;
SQLTransaction2.Active := TRUE;
sqlqProgrammer.SQL.Text := 'Select * from Programmer ORDER BY ID DESC';
sqlqProgrammer.Open;
end;

procedure TfrmContributions.Savechanges;
// Saves edits done by user, if any.
begin
try
if SQLTransaction2.Active then
// Only if we are within a started transaction
// otherwise you get "Operation cannot be performed on an inactive dataset"
begin
  sqlqProgrammer.ApplyUpdates; //Pass user-generated changes back to database...
  SQLTransaction2.Commit; //... and commit them using the transaction.
  //SQLTransaction2.Active now is false
 end;
 except
 on E: EDatabaseError do
 begin
  MessageDlg('Error', 'A database error has occurred. Technical error message: ' +
    E.Message, mtError, [mbOK], 0);
      end;
 end;
 end;
procedure TfrmContributions.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SaveChanges;
sqlqProgrammer.Close;
SQLTransaction2.Commit;
SQLTransaction2.RollBack;
SQLTransaction2.Active := False;
IBConnection2.Connected  := False;
end;

end.  

I tried adding a formclose to my first form as follows in order to solved the problem but it does not seem to be doing anything:

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
frmContributions.SaveChanges;
frmContributions.SQLTransaction2.RollBack;
frmContributions.SQLTransaction2.Active := False;
frmContributions.IBConnection2.Connected  := False;
end;

I have tried different solutions found on the internet but I am still getting:

"SQLTransaction2 : Operation cannot be performed on an active transaction" when i close my project using the debugger, and also I get the same error when closing down code typhon.

Here is the lfm file:

object frmContributions: TfrmContributions
Left = 816
Height = 415
Top = 172
Width = 774
Caption = 'Data Entry for Promo'
ClientHeight = 415
ClientWidth = 774
Color = clHighlight
OnClose = FormClose
LCLVersion = '1.3'
object btnUpdate: TButton
Left = 536
Height = 25
Top = 376
Width = 168
Caption = 'Update programmers'
OnClick = btnUpdateClick
TabOrder = 0
end
object dbgrdProgrammer: TDBGrid
Left = 16
Height = 360
Top = 0
Width = 744
Color = clWindow
Columns = <    
  item
    Title.Caption = 'ID'
    Width = 60
    FieldName = 'ID'
  end    
  item
    Title.Caption = 'DATESENT'
    FieldName = 'DATESENT'
  end    
  item
    Title.Caption = 'COURSE'
    Width = 140
    FieldName = 'COURSE'
  end    
  item
    Title.Caption = 'PROMOTYPE'
    Width = 140
    FieldName = 'PROMOTYPE'
  end    
  item
    Title.Caption = 'LINK'
    Width = 100
    FieldName = 'LINK'
  end    
  item
    Title.Caption = 'VALUE'
    Width = 50
    FieldName = 'VALUECHART'
  end    
  item
    Title.Caption = 'TOTALSENT'
    FieldName = 'TOTALSENT'
  end    
  item
    Title.Caption = 'NOTES'
    FieldName = 'NOTES'
  end>
DataSource = dsProgrammer
TabOrder = 1
OnTitleClick = dbgrdProgrammerTitleClick
end
object dbnavProgrammer: TDBNavigator
Left = 280
Height = 25
Top = 376
Width = 241
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 25
ClientWidth = 241
DataSource = dsProgrammer
Options = []
TabOrder = 2
VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbRefresh]
end
object btnDeleteProgrammer: TButton
Left = 64
Height = 25
Top = 376
Width = 201
Caption = 'Delete Selected Programmer'
OnClick = btnDeleteProgrammerClick
TabOrder = 3
end
object dsProgrammer: TDataSource
DataSet = sqlqProgrammer
left = 696
top = 168
end
object IBConnection2: TIBConnection
Connected = True
LoginPrompt = False
DatabaseName = '.......CONTRIBUTIONS.FDB'
KeepConnection = False
Password = 'password'
Transaction = SQLTransaction2
UserName = 'username'
HostName = 'hostname'
left = 696
top = 8
end
object SQLTransaction2: TSQLTransaction
Active = True
Action = caCommitRetaining
Database = IBConnection2
left = 696
top = 56
end
object sqlqProgrammer: TSQLQuery
IndexName = 'DEFAULT_ORDER'
FieldDefs = <    
  item
    Name = 'ID'
    DataType = ftInteger
    Precision = -1
    Size = 0
  end    
  item
    Name = 'DATESENT'
    DataType = ftDate
    Precision = -1
    Size = 0
  end    
  item
    Name = 'PROMOTYPE'
    DataType = ftString
    Precision = -1
    Size = 25
  end    
  item
    Name = 'COURSE'
    DataType = ftString
    Precision = -1
    Size = 25
  end    
  item
    Name = 'LINK'
    DataType = ftString
    Precision = -1
    Size = 450
  end    
  item
    Name = 'VALUECHART'
    DataType = ftInteger
    Precision = -1
    Size = 0
  end>
Active = True
Database = IBConnection2
Transaction = SQLTransaction2
SQL.Strings = (
  'select * from Programmer order by ID DESC'
)
UpdateSQL.Strings = (
  ''
)
InsertSQL.Strings = (
  ''
)
DeleteSQL.Strings = (
  ''
)
Params = <>
UpdateMode = upWhereChanged
UsePrimaryKeyAsKey = False
left = 696
top = 224
end
object SQLScript1: TSQLScript
DataBase = IBConnection2
Transaction = SQLTransaction2
Directives.Strings = (
  'SET TERM'
  'COMMIT'
  '#IFDEF'
  '#IFNDEF'
  '#ELSE'
  '#ENDIF'
  '#DEFINE'
  '#UNDEF'
  '#UNDEFINE'
)
Script.Strings = (
  ''
)
Terminator = ';'
CommentsinSQL = True
UseSetTerm = True
UseCommit = True
UseDefines = True
left = 696
top = 112
end
end 

Thank you.


Solution

  • Actually I don't know exactly what should be next, but

    (0) I'd move the database code into standalone TDataModule (outside the UI code) to make the code more straightforward to read and maintain. During this refactoring you may spot a hidden problem..

    (1) this http://forum.lazarus.freepascal.org/index.php?topic=14301.0 seems to solve similar problem

    (2) book Lazarus, the complete guide seems to have a chapter about TDataModule

    (3) Martin Fowler wrote a book about refactoring and runs a site about the same at http://refactoring.com/

    (4) some components don't behave well if they are active in the design mode. As it is actually different and more complicated scenario (lots of ifs with csDesigning in ComponentState, sequence diagram of events is different, nearly random and everything should be foolproof and re-entrant..). So safe side for production is to turn component's active state off in the design mode and activate them in code in a well defined order anticipated by the component authors

    (5) If you experience the error only when in the debugger and it does not appear in production code I think that you can ignore the problem as the debugging environment is <see="(4)">