1

我需要一些帮助来解决此错误消息。

我在 Windows 7 Pro 上使用 Code Typhon32 V4.9。

我有一个连接到 firebird 数据库的项目，单一表单可以正常工作 - 没问题。

我添加了第二个表单作为我的数据输入表单，该表单链接到 Firebird 中的另一个数据库——我在一个项目中需要两个数据库。

由于添加了第二种形式，当我关闭代码台风和使用调试器关闭 Form1 时出现以下错误：“SQLTransaction2：无法对活动事务执行操作”

我尝试了许多在互联网上找到的解决方案，但无法解决。

我有一个按钮可以打开第二个，如下所示：

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

这是我的第二种形式代码：

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.

我尝试按如下方式在我的第一个表单中添加一个表单以解决问题，但它似乎没有做任何事情：

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

我尝试了在互联网上找到的不同解决方案，但我仍然得到：

当我使用调试器关闭我的项目时，“SQLTransaction2：无法对活动事务执行操作”，并且在关闭代码台风时我也会遇到同样的错误。

这是lfm文件：

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

谢谢你。

4

1 回答 1

0

其实我不知道接下来应该是什么，但是

(0)我会将数据库代码移动到独立的 TDataModule 中（在 UI 代码之外），以使代码更易于阅读和维护。在此重构过程中，您可能会发现一个隐藏的问题。

(1)这个http://forum.lazarus.freepascal.org/index.php?topic=14301.0似乎解决了类似的问题

(2) book Lazarus, the complete guide好像有一章关于TDataModule

(3) Martin Fowler 写了一本关于重构的书，并在http://refactoring.com/上运行了一个类似的网站

(4)如果某些组件在设计模式下处于活动状态，则它们的表现不佳。因为它实际上是不同且更复杂的场景（很多ifs csDesigning in ComponentState，事件的序列图是不同的，几乎是随机的，一切都应该是万无一失的和可重入的......）。因此，生产的安全方面是在设计模式下关闭组件的活动状态，并以组件作者预期的明确定义的顺序在代码中激活它们

(5)如果你只在调试器中遇到错误并且它没有出现在生产代码中，我认为你可以忽略这个问题，因为调试环境是 <see="(4)">

于 2014-08-19T01:10:20.133 回答