examples/services/LimboTransactionsUnit.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit LimboTransactionsUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ActnList, db, IBXServices, IBDynamicGrid;

type
  { TLimboTransactionsForm }

  TLimboTransactionsForm = class(TForm)
    ApplySelectedAction: TAction;
    Commit2PhaseAll: TAction;

      IBXLimboTransactionResolutionService1: TIBXLimboTransactionResolutionService;
      InLimboList: TIBXServicesLimboTransactionsList;
    RollbackAll: TAction;
    CommitAll: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    IBDynamicGrid3: TIBDynamicGrid;
    Label38: TLabel;
    Label39: TLabel;
    LimboListSource: TDataSource;
    LimboReport: TMemo;
    procedure ApplySelectedActionExecute(Sender: TObject);
    procedure Commit2PhaseAllExecute(Sender: TObject);
    procedure CommitAllExecute(Sender: TObject);
    procedure CommitAllUpdate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure RollbackAllExecute(Sender: TObject);
  private
    { private declarations }
    procedure DoRefresh(Data: PtrInt);
  public
    { public declarations }
  end;

var
  LimboTransactionsForm: TLimboTransactionsForm;

implementation

{$R *.lfm}

{ TLimboTransactionsForm }

procedure TLimboTransactionsForm.FormShow(Sender: TObject);
begin
  Application.QueueAsyncCall(@DoRefresh,0);
  LimboReport.Lines.Clear;
end;

procedure TLimboTransactionsForm.RollbackAllExecute(Sender: TObject);
begin
  InLimboList.FixErrors(RollbackGlobal,LimboReport.Lines);
end;

procedure TLimboTransactionsForm.ApplySelectedActionExecute(Sender: TObject);
begin
  InLimboList.FixErrors(NoGlobalAction,LimboReport.Lines);
end;

procedure TLimboTransactionsForm.Commit2PhaseAllExecute(Sender: TObject);
begin
  InLimboList.FixErrors(RecoverTwoPhaseGlobal,LimboReport.Lines);
end;

procedure TLimboTransactionsForm.CommitAllExecute(Sender: TObject);
begin
  InLimboList.FixErrors(CommitGlobal,LimboReport.Lines);
end;

procedure TLimboTransactionsForm.CommitAllUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := InLimboList.Active and (InLimboList.RecordCount > 0);
end;

procedure TLimboTransactionsForm.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  InLimboList.Active := false;
end;

procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
begin
  InLimboList.Active := false;
  InLimboList.Active := true;
end;

end.

Revision:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	3423 byte(s)
Log Message:	Fixes Merged
#	Content
1	(*
2	* IBX For Lazarus (Firebird Express)
3	*
4	* The contents of this file are subject to the Initial Developer's
5	* Public License Version 1.0 (the "License"); you may not use this
6	* file except in compliance with the License. You may obtain a copy
7	* of the License here:
8	*
9	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10	*
11	* Software distributed under the License is distributed on an "AS
12	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13	* implied. See the License for the specific language governing rights
14	* and limitations under the License.
15	*
16	* The Initial Developer of the Original Code is Tony Whyman.
17	*
18	* The Original Code is (C) 2015 Tony Whyman, MWA Software
19	* (http://www.mwasoftware.co.uk).
20	*
21	* All Rights Reserved.
22	*
23	* Contributor(s): ______________________________________.
24	*
25	*)
26
27	unit LimboTransactionsUnit;
28
29	{$mode objfpc}{$H+}
30
31	interface
32
33	uses
34	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	ActnList, db, IBXServices, IBDynamicGrid;
36
37	type
38	{ TLimboTransactionsForm }
39
40	TLimboTransactionsForm = class(TForm)
41	ApplySelectedAction: TAction;
42	Commit2PhaseAll: TAction;
43
44	IBXLimboTransactionResolutionService1: TIBXLimboTransactionResolutionService;
45	InLimboList: TIBXServicesLimboTransactionsList;
46	RollbackAll: TAction;
47	CommitAll: TAction;
48	ActionList1: TActionList;
49	Button1: TButton;
50	Button2: TButton;
51	Button3: TButton;
52	Button4: TButton;
53	Button5: TButton;
54	IBDynamicGrid3: TIBDynamicGrid;
55	Label38: TLabel;
56	Label39: TLabel;
57	LimboListSource: TDataSource;
58	LimboReport: TMemo;
59	procedure ApplySelectedActionExecute(Sender: TObject);
60	procedure Commit2PhaseAllExecute(Sender: TObject);
61	procedure CommitAllExecute(Sender: TObject);
62	procedure CommitAllUpdate(Sender: TObject);
63	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
64	procedure FormShow(Sender: TObject);
65	procedure RollbackAllExecute(Sender: TObject);
66	private
67	{ private declarations }
68	procedure DoRefresh(Data: PtrInt);
69	public
70	{ public declarations }
71	end;
72
73	var
74	LimboTransactionsForm: TLimboTransactionsForm;
75
76	implementation
77
78	{$R *.lfm}
79
80	{ TLimboTransactionsForm }
81
82	procedure TLimboTransactionsForm.FormShow(Sender: TObject);
83	begin
84	Application.QueueAsyncCall(@DoRefresh,0);
85	LimboReport.Lines.Clear;
86	end;
87
88	procedure TLimboTransactionsForm.RollbackAllExecute(Sender: TObject);
89	begin
90	InLimboList.FixErrors(RollbackGlobal,LimboReport.Lines);
91	end;
92
93	procedure TLimboTransactionsForm.ApplySelectedActionExecute(Sender: TObject);
94	begin
95	InLimboList.FixErrors(NoGlobalAction,LimboReport.Lines);
96	end;
97
98	procedure TLimboTransactionsForm.Commit2PhaseAllExecute(Sender: TObject);
99	begin
100	InLimboList.FixErrors(RecoverTwoPhaseGlobal,LimboReport.Lines);
101	end;
102
103	procedure TLimboTransactionsForm.CommitAllExecute(Sender: TObject);
104	begin
105	InLimboList.FixErrors(CommitGlobal,LimboReport.Lines);
106	end;
107
108	procedure TLimboTransactionsForm.CommitAllUpdate(Sender: TObject);
109	begin
110	(Sender as TAction).Enabled := InLimboList.Active and (InLimboList.RecordCount > 0);
111	end;
112
113	procedure TLimboTransactionsForm.FormClose(Sender: TObject;
114	var CloseAction: TCloseAction);
115	begin
116	InLimboList.Active := false;
117	end;
118
119	procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
120	begin
121	InLimboList.Active := false;
122	InLimboList.Active := true;
123	end;
124
125	end.
126