ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/examples/services/LimboTransactionsUnit.pas

Comparing ibx/trunk/examples/services/LimboTransactionsUnit.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 147 by tony, Mon Feb 26 11:14:30 2018 UTC

#	Line 1 | Line 1
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+}
#	Line 6 | Line 32 | interface
32
33		uses
34		Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35	<	Grids, IBServices;
35	>	Grids, ActnList, db, memds, IBServices, IBDynamicGrid;
36
37		type
38		{ TLimboTransactionsForm }
39
40		TLimboTransactionsForm = class(TForm)
41	+	ApplySelectedAction: TAction;
42	+	Commit2PhaseAll: TAction;
43	+	RollbackAll: TAction;
44	+	CommitAll: TAction;
45	+	ActionList1: TActionList;
46		Button1: TButton;
47		Button2: TButton;
48		Button3: TButton;
49		Button4: TButton;
50	<	IBValidationService1: TIBValidationService;
51	<	Label1: TLabel;
52	<	StringGrid1: TStringGrid;
53	<	procedure Button1Click(Sender: TObject);
54	<	procedure Button2Click(Sender: TObject);
55	<	procedure Button3Click(Sender: TObject);
56	<	procedure Button4Click(Sender: TObject);
50	>	Button5: TButton;
51	>	IBDynamicGrid3: TIBDynamicGrid;
52	>	InLimboList: TMemDataset;
53	>	Label38: TLabel;
54	>	Label39: TLabel;
55	>	LimboListSource: TDataSource;
56	>	LimboReport: TMemo;
57	>	LimboTransactionValidation: TIBValidationService;
58	>	procedure ApplySelectedActionExecute(Sender: TObject);
59	>	procedure Commit2PhaseAllExecute(Sender: TObject);
60	>	procedure CommitAllExecute(Sender: TObject);
61	>	procedure CommitAllUpdate(Sender: TObject);
62	>	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
63		procedure FormShow(Sender: TObject);
64	<	procedure StringGrid1EditingDone(Sender: TObject);
64	>	procedure InLimboListAfterOpen(DataSet: TDataSet);
65	>	procedure InLimboListBeforeClose(DataSet: TDataSet);
66	>	procedure InLimboListBeforePost(DataSet: TDataSet);
67	>	procedure RollbackAllExecute(Sender: TObject);
68		private
69		{ private declarations }
70	+	FLoadingLimboTr: boolean;
71		procedure DoRefresh(Data: PtrInt);
31	–	function StateToStr(State: TTransactionState): string;
32	–	function AdviseToStr(Advise: TTransactionAdvise): string;
33	–	function ActionToStr(anAction: TTransactionAction): string;
72		procedure RunGFix;
73		public
74		{ public declarations }
#	Line 43 | Line 81 | implementation
81
82		{$R *.lfm}
83
84	<	uses Unit1;
84	>	uses MainFormUnit;
85
86		{ TLimboTransactionsForm }
87
88		procedure TLimboTransactionsForm.FormShow(Sender: TObject);
89		begin
90		Application.QueueAsyncCall(@DoRefresh,0);
91	+	LimboReport.Lines.Clear;
92		end;
93
94	<	procedure TLimboTransactionsForm.Button1Click(Sender: TObject);
56	<	begin
57	<	IBValidationService1.GlobalAction := CommitGlobal;
58	<	RunGFix;
59	<	end;
60	<
61	<	procedure TLimboTransactionsForm.Button2Click(Sender: TObject);
62	<	begin
63	<	IBValidationService1.GlobalAction := RollbackGlobal;
64	<	RunGFix;
65	<	end;
66	<
67	<	procedure TLimboTransactionsForm.Button3Click(Sender: TObject);
68	<	begin
69	<	IBValidationService1.GlobalAction := NoGlobalAction;
70	<	RunGFix;
71	<	end;
94	>	procedure TLimboTransactionsForm.InLimboListAfterOpen(DataSet: TDataSet);
95
96	<	procedure TLimboTransactionsForm.Button4Click(Sender: TObject);
96	>	function TypeToStr(MultiDatabase: boolean): string;
97		begin
98	<	IBValidationService1.GlobalAction := RecoverTwoPhaseGlobal;
99	<	RunGFix;
100	<	end;
101	<
79	<	procedure TLimboTransactionsForm.StringGrid1EditingDone(Sender: TObject);
80	<	begin
81	<	with StringGrid1, IBValidationService1 do
82	<	if col = 7 then
83	<	begin
84	<	if Cells[7,row] = 'Commit' then
85	<	LimboTransactionInfo[row-1].Action := CommitAction
86	<	else
87	<	if Cells[7,row] = 'Rollback' then
88	<	LimboTransactionInfo[row-1].Action := RollbackAction
89	<	end;
90	<	end;
91	<
92	<	procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
93	<	var i: integer;
94	<	begin
95	<	with IBValidationService1 do
96	<	begin
97	<	Active := true;
98	<	ServiceStart;
99	<	FetchLimboTransactionInfo;
100	<	StringGrid1.RowCount := LimboTransactionInfoCount + 1;
101	<	for i := 0 to LimboTransactionInfoCount - 1 do
102	<	with LimboTransactionInfo[i] do
103	<	begin
104	<	StringGrid1.Cells[0,i+1] := IntToStr(ID);
105	<	if MultiDatabase then
106	<	StringGrid1.Cells[1,i+1] := 'Multi DB'
107	<	else
108	<	StringGrid1.Cells[1,i+1] := 'Single DB';
109	<	StringGrid1.Cells[2,i+1] := HostSite;
110	<	StringGrid1.Cells[3,i+1] := RemoteSite;
111	<	StringGrid1.Cells[4,i+1] := RemoteDatabasePath;
112	<	StringGrid1.Cells[5,i+1] := StateToStr(State);
113	<	StringGrid1.Cells[6,i+1] := AdviseToStr(Advise);
114	<	StringGrid1.Cells[7,i+1] := ActionToStr(Action);
115	<	end;
116	<	end;
98	>	if MultiDatabase then
99	>	Result := 'Multi DB'
100	>	else
101	>	Result := 'Single DB';
102		end;
103
104	<	function TLimboTransactionsForm.StateToStr(State: TTransactionState): string;
104	>	function StateToStr(State: TTransactionState): string;
105		begin
106		case State of
107		LimboState:
#	Line 130 | Line 115 | begin
115		end;
116		end;
117
118	<	function TLimboTransactionsForm.AdviseToStr(Advise: TTransactionAdvise): string;
118	>	function AdviseToStr(Advise: TTransactionAdvise): string;
119		begin
120		case Advise of
121		CommitAdvise:
#	Line 142 | Line 127 | begin
127		end;
128		end;
129
130	<	function TLimboTransactionsForm.ActionToStr(anAction: TTransactionAction
146	<	): string;
130	>	function ActionToStr(anAction: IBServices.TTransactionAction): string;
131		begin
132		case anAction of
133		CommitAction:
#	Line 153 | Line 137 | begin
137		end;
138		end;
139
140	+	var i: integer;
141	+	begin
142	+	if FLoadingLimboTr then Exit;
143	+	FLoadingLimboTr := true;
144	+	with LimboTransactionValidation do
145	+	try
146	+	Active := true;
147	+	ServiceStart;
148	+	FetchLimboTransactionInfo;
149	+	for i := 0 to LimboTransactionInfoCount - 1 do
150	+	with LimboTransactionInfo[i] do
151	+	begin
152	+	InLimboList.Append;
153	+	InLimboList.FieldByName('TransactionID').AsInteger := ID;
154	+	InLimboList.FieldByName('TransactionType').AsString := TypeToStr(MultiDatabase);
155	+	InLimboList.FieldByName('HostSite').AsString := HostSite;
156	+	InLimboList.FieldByName('RemoteSite').AsString := RemoteSite;
157	+	InLimboList.FieldByName('DatabasePath').AsString := RemoteDatabasePath;
158	+	InLimboList.FieldByName('State').AsString := StateToStr(State);
159	+	InLimboList.FieldByName('RecommendedAction').AsString := AdviseToStr(Advise);
160	+	InLimboList.FieldByName('RequestedAction').AsString := ActionToStr(Action);
161	+	InLimboList.Post;
162	+	end;
163	+	finally
164	+	FLoadingLimboTr := false;
165	+	end;
166	+	end;
167	+
168	+	procedure TLimboTransactionsForm.InLimboListBeforeClose(DataSet: TDataSet);
169	+	begin
170	+	InLimboList.Clear(false);
171	+	end;
172	+
173	+	procedure TLimboTransactionsForm.InLimboListBeforePost(DataSet: TDataSet);
174	+	var i: integer;
175	+	begin
176	+	if FLoadingLimboTr then Exit;
177	+	with LimboTransactionValidation do
178	+	for i := 0 to LimboTransactionInfoCount - 1 do
179	+	with LimboTransactionInfo[i] do
180	+	begin
181	+	if ID = InLimboList.FieldByName('TransactionID').AsInteger then
182	+	begin
183	+	if InLimboList.FieldByName('RequestedAction').AsString = 'Commit' then
184	+	Action := CommitAction
185	+	else
186	+	if InLimboList.FieldByName('RequestedAction').AsString = 'Rollback' then
187	+	Action := RollbackAction;
188	+	break;
189	+	end;
190	+	end;
191	+	end;
192	+
193	+	procedure TLimboTransactionsForm.RollbackAllExecute(Sender: TObject);
194	+	begin
195	+	LimboTransactionValidation.GlobalAction := RollbackGlobal;
196	+	RunGFix;
197	+	end;
198	+
199	+	procedure TLimboTransactionsForm.ApplySelectedActionExecute(Sender: TObject);
200	+	begin
201	+	LimboTransactionValidation.GlobalAction := NoGlobalAction;
202	+	RunGFix;
203	+	end;
204	+
205	+	procedure TLimboTransactionsForm.Commit2PhaseAllExecute(Sender: TObject);
206	+	begin
207	+	LimboTransactionValidation.GlobalAction := RecoverTwoPhaseGlobal;
208	+	RunGFix;
209	+	end;
210	+
211	+	procedure TLimboTransactionsForm.CommitAllExecute(Sender: TObject);
212	+	begin
213	+	LimboTransactionValidation.GlobalAction := CommitGlobal;
214	+	RunGFix;
215	+	end;
216	+
217	+	procedure TLimboTransactionsForm.CommitAllUpdate(Sender: TObject);
218	+	begin
219	+	(Sender as TAction).Enabled := InLimboList.Active and (InLimboList.RecordCount > 0);
220	+	end;
221	+
222	+	procedure TLimboTransactionsForm.FormClose(Sender: TObject;
223	+	var CloseAction: TCloseAction);
224	+	begin
225	+	InLimboList.Active := false;
226	+	end;
227	+
228	+	procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
229	+	begin
230	+	InLimboList.Active := false;
231	+	InLimboList.Active := true;
232	+	end;
233	+
234		procedure TLimboTransactionsForm.RunGFix;
235		begin
236	<	with IBValidationService1 do
236	>	if not InLimboList.Active then
237	>	raise Exception.Create('Limbo Transactions List not available');
238	>
239	>	with InLimboList do
240	>	if State = dsEdit then Post;
241	>	LimboReport.Lines.Clear;
242	>
243	>	with LimboTransactionValidation do
244		begin
245	<	Form1.Memo1.Lines.Add('Starting Limbo transaction resolution');
245	>	LimboReport.Lines.Add('Starting Limbo transaction resolution');
246		FixLimboTransactionErrors;
247		while not Eof do
248		begin
249	<	Form1.Memo1.Lines.Add(GetNextLine);
249	>	LimboReport.Lines.Add(GetNextLine);
250		Application.ProcessMessages;
251		end;
252	<	Form1.Memo1.Lines.Add('Limbo Transaction resolution complete');
252	>	LimboReport.Lines.Add('Limbo Transaction resolution complete');
253		Application.QueueAsyncCall(@DoRefresh,0);
254		end;
255		end;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines