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,
  Grids, IBServices;

type
  { TLimboTransactionsForm }

  TLimboTransactionsForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    LimboTransactionValidation: TIBValidationService;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure StringGrid1EditingDone(Sender: TObject);
  private
    { private declarations }
    procedure DoRefresh(Data: PtrInt);
    function StateToStr(State: TTransactionState): string;
    function AdviseToStr(Advise: TTransactionAdvise): string;
    function ActionToStr(anAction: TTransactionAction): string;
    procedure RunGFix;
  public
    { public declarations }
  end;

var
  LimboTransactionsForm: TLimboTransactionsForm;

implementation

{$R *.lfm}

uses MainFormUnit;

{ TLimboTransactionsForm }

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

procedure TLimboTransactionsForm.Button1Click(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := CommitGlobal;
  RunGFix;
end;

procedure TLimboTransactionsForm.Button2Click(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := RollbackGlobal;
  RunGFix;
end;

procedure TLimboTransactionsForm.Button3Click(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := NoGlobalAction;
  RunGFix;
end;

procedure TLimboTransactionsForm.Button4Click(Sender: TObject);
begin
  LimboTransactionValidation.GlobalAction := RecoverTwoPhaseGlobal;
  RunGFix;
end;

procedure TLimboTransactionsForm.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
end;

procedure TLimboTransactionsForm.StringGrid1EditingDone(Sender: TObject);
begin
  with StringGrid1, LimboTransactionValidation do
  if col = 7 then
  begin
    if Cells[7,row] = 'Commit' then
      LimboTransactionInfo[row-1].Action := CommitAction
    else
      if Cells[7,row] = 'Rollback' then
        LimboTransactionInfo[row-1].Action := RollbackAction
  end;
end;

procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
var i: integer;
begin
  with LimboTransactionValidation do
  begin
    Active := true;
    ServiceStart;
    FetchLimboTransactionInfo;
    StringGrid1.RowCount := LimboTransactionInfoCount + 1;
    for i := 0 to LimboTransactionInfoCount - 1 do
    with LimboTransactionInfo[i] do
    begin
      StringGrid1.Cells[0,i+1] := IntToStr(ID);
      if MultiDatabase then
        StringGrid1.Cells[1,i+1] := 'Multi DB'
      else
        StringGrid1.Cells[1,i+1] := 'Single DB';
      StringGrid1.Cells[2,i+1] := HostSite;
      StringGrid1.Cells[3,i+1] := RemoteSite;
      StringGrid1.Cells[4,i+1] := RemoteDatabasePath;
      StringGrid1.Cells[5,i+1] := StateToStr(State);
      StringGrid1.Cells[6,i+1] := AdviseToStr(Advise);
      StringGrid1.Cells[7,i+1] := ActionToStr(Action);
    end;
  end;
end;

function TLimboTransactionsForm.StateToStr(State: TTransactionState): string;
begin
  case State of
  LimboState:
    Result := 'Limbo';
  CommitState:
    Result := 'Commit';
  RollbackState:
    Result := 'Rollback';
  else
    Result := 'Unknown';
  end;
end;

function TLimboTransactionsForm.AdviseToStr(Advise: TTransactionAdvise): string;
begin
  case Advise of
  CommitAdvise:
    Result := 'Commit';
  RollbackAdvise:
    Result := 'Rollback';
  else
    Result := 'Unknown';
  end;
end;

function TLimboTransactionsForm.ActionToStr(anAction: TTransactionAction
  ): string;
begin
  case anAction of
  CommitAction:
    Result := 'Commit';
  RollbackAction:
    Result := 'Rollback';
  end;
end;

procedure TLimboTransactionsForm.RunGFix;
begin
  with LimboTransactionValidation do
  begin
    MainForm.Memo1.Lines.Add('Starting Limbo transaction resolution');
    FixLimboTransactionErrors;
    while not Eof do
    begin
      MainForm.Memo1.Lines.Add(GetNextLine);
      Application.ProcessMessages;
    end;
    MainForm.Memo1.Lines.Add('Limbo Transaction resolution complete');
    Application.QueueAsyncCall(@DoRefresh,0);
  end;
end;

end.

Revision:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	5311 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			Grids, IBServices;
36
37			type
38			{ TLimboTransactionsForm }
39
40			TLimboTransactionsForm = class(TForm)
41			Button1: TButton;
42			Button2: TButton;
43			Button3: TButton;
44			Button4: TButton;
45	tony	143	LimboTransactionValidation: TIBValidationService;
46	tony	45	Label1: TLabel;
47			StringGrid1: TStringGrid;
48			procedure Button1Click(Sender: TObject);
49			procedure Button2Click(Sender: TObject);
50			procedure Button3Click(Sender: TObject);
51			procedure Button4Click(Sender: TObject);
52	tony	143	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
53	tony	45	procedure FormShow(Sender: TObject);
54			procedure StringGrid1EditingDone(Sender: TObject);
55			private
56			{ private declarations }
57			procedure DoRefresh(Data: PtrInt);
58			function StateToStr(State: TTransactionState): string;
59			function AdviseToStr(Advise: TTransactionAdvise): string;
60			function ActionToStr(anAction: TTransactionAction): string;
61			procedure RunGFix;
62			public
63			{ public declarations }
64			end;
65
66			var
67			LimboTransactionsForm: TLimboTransactionsForm;
68
69			implementation
70
71			{$R *.lfm}
72
73	tony	143	uses MainFormUnit;
74	tony	45
75			{ TLimboTransactionsForm }
76
77			procedure TLimboTransactionsForm.FormShow(Sender: TObject);
78			begin
79			Application.QueueAsyncCall(@DoRefresh,0);
80			end;
81
82			procedure TLimboTransactionsForm.Button1Click(Sender: TObject);
83			begin
84	tony	143	LimboTransactionValidation.GlobalAction := CommitGlobal;
85	tony	45	RunGFix;
86			end;
87
88			procedure TLimboTransactionsForm.Button2Click(Sender: TObject);
89			begin
90	tony	143	LimboTransactionValidation.GlobalAction := RollbackGlobal;
91	tony	45	RunGFix;
92			end;
93
94			procedure TLimboTransactionsForm.Button3Click(Sender: TObject);
95			begin
96	tony	143	LimboTransactionValidation.GlobalAction := NoGlobalAction;
97	tony	45	RunGFix;
98			end;
99
100			procedure TLimboTransactionsForm.Button4Click(Sender: TObject);
101			begin
102	tony	143	LimboTransactionValidation.GlobalAction := RecoverTwoPhaseGlobal;
103	tony	45	RunGFix;
104			end;
105
106	tony	143	procedure TLimboTransactionsForm.FormClose(Sender: TObject;
107			var CloseAction: TCloseAction);
108			begin
109			end;
110
111	tony	45	procedure TLimboTransactionsForm.StringGrid1EditingDone(Sender: TObject);
112			begin
113	tony	143	with StringGrid1, LimboTransactionValidation do
114	tony	45	if col = 7 then
115			begin
116			if Cells[7,row] = 'Commit' then
117			LimboTransactionInfo[row-1].Action := CommitAction
118			else
119			if Cells[7,row] = 'Rollback' then
120			LimboTransactionInfo[row-1].Action := RollbackAction
121			end;
122			end;
123
124			procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
125			var i: integer;
126			begin
127	tony	143	with LimboTransactionValidation do
128	tony	45	begin
129			Active := true;
130			ServiceStart;
131			FetchLimboTransactionInfo;
132			StringGrid1.RowCount := LimboTransactionInfoCount + 1;
133			for i := 0 to LimboTransactionInfoCount - 1 do
134			with LimboTransactionInfo[i] do
135			begin
136			StringGrid1.Cells[0,i+1] := IntToStr(ID);
137			if MultiDatabase then
138			StringGrid1.Cells[1,i+1] := 'Multi DB'
139			else
140			StringGrid1.Cells[1,i+1] := 'Single DB';
141			StringGrid1.Cells[2,i+1] := HostSite;
142			StringGrid1.Cells[3,i+1] := RemoteSite;
143			StringGrid1.Cells[4,i+1] := RemoteDatabasePath;
144			StringGrid1.Cells[5,i+1] := StateToStr(State);
145			StringGrid1.Cells[6,i+1] := AdviseToStr(Advise);
146			StringGrid1.Cells[7,i+1] := ActionToStr(Action);
147			end;
148			end;
149			end;
150
151			function TLimboTransactionsForm.StateToStr(State: TTransactionState): string;
152			begin
153			case State of
154			LimboState:
155			Result := 'Limbo';
156			CommitState:
157			Result := 'Commit';
158			RollbackState:
159			Result := 'Rollback';
160			else
161			Result := 'Unknown';
162			end;
163			end;
164
165			function TLimboTransactionsForm.AdviseToStr(Advise: TTransactionAdvise): string;
166			begin
167			case Advise of
168			CommitAdvise:
169			Result := 'Commit';
170			RollbackAdvise:
171			Result := 'Rollback';
172			else
173			Result := 'Unknown';
174			end;
175			end;
176
177			function TLimboTransactionsForm.ActionToStr(anAction: TTransactionAction
178			): string;
179			begin
180			case anAction of
181			CommitAction:
182			Result := 'Commit';
183			RollbackAction:
184			Result := 'Rollback';
185			end;
186			end;
187
188			procedure TLimboTransactionsForm.RunGFix;
189			begin
190	tony	143	with LimboTransactionValidation do
191	tony	45	begin
192	tony	143	MainForm.Memo1.Lines.Add('Starting Limbo transaction resolution');
193	tony	45	FixLimboTransactionErrors;
194			while not Eof do
195			begin
196	tony	143	MainForm.Memo1.Lines.Add(GetNextLine);
197	tony	45	Application.ProcessMessages;
198			end;
199	tony	143	MainForm.Memo1.Lines.Add('Limbo Transaction resolution complete');
200	tony	45	Application.QueueAsyncCall(@DoRefresh,0);
201			end;
202			end;
203
204			end.
205