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, 1 month ago) by tony
Content type:	text/x-pascal
File size:	3423 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	143	(*
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	tony	45	unit LimboTransactionsUnit;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	tony	209	ActnList, db, IBXServices, IBDynamicGrid;
36	tony	45
37			type
38			{ TLimboTransactionsForm }
39
40			TLimboTransactionsForm = class(TForm)
41	tony	147	ApplySelectedAction: TAction;
42			Commit2PhaseAll: TAction;
43	tony	209
44			IBXLimboTransactionResolutionService1: TIBXLimboTransactionResolutionService;
45			InLimboList: TIBXServicesLimboTransactionsList;
46	tony	147	RollbackAll: TAction;
47			CommitAll: TAction;
48			ActionList1: TActionList;
49	tony	45	Button1: TButton;
50			Button2: TButton;
51			Button3: TButton;
52			Button4: TButton;
53	tony	147	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	tony	143	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
64	tony	45	procedure FormShow(Sender: TObject);
65	tony	147	procedure RollbackAllExecute(Sender: TObject);
66	tony	45	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	tony	147	LimboReport.Lines.Clear;
86	tony	45	end;
87
88	tony	147	procedure TLimboTransactionsForm.RollbackAllExecute(Sender: TObject);
89			begin
90	tony	209	InLimboList.FixErrors(RollbackGlobal,LimboReport.Lines);
91	tony	147	end;
92
93			procedure TLimboTransactionsForm.ApplySelectedActionExecute(Sender: TObject);
94			begin
95	tony	209	InLimboList.FixErrors(NoGlobalAction,LimboReport.Lines);
96	tony	147	end;
97
98			procedure TLimboTransactionsForm.Commit2PhaseAllExecute(Sender: TObject);
99			begin
100	tony	209	InLimboList.FixErrors(RecoverTwoPhaseGlobal,LimboReport.Lines);
101	tony	147	end;
102
103			procedure TLimboTransactionsForm.CommitAllExecute(Sender: TObject);
104			begin
105	tony	209	InLimboList.FixErrors(CommitGlobal,LimboReport.Lines);
106	tony	147	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	tony	45	end.
126