ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/services/LimboTransactionsUnit.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 4208 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# Content
1 unit LimboTransactionsUnit;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9 Grids, IBServices;
10
11 type
12 { TLimboTransactionsForm }
13
14 TLimboTransactionsForm = class(TForm)
15 Button1: TButton;
16 Button2: TButton;
17 Button3: TButton;
18 Button4: TButton;
19 IBValidationService1: TIBValidationService;
20 Label1: TLabel;
21 StringGrid1: TStringGrid;
22 procedure Button1Click(Sender: TObject);
23 procedure Button2Click(Sender: TObject);
24 procedure Button3Click(Sender: TObject);
25 procedure Button4Click(Sender: TObject);
26 procedure FormShow(Sender: TObject);
27 procedure StringGrid1EditingDone(Sender: TObject);
28 private
29 { private declarations }
30 procedure DoRefresh(Data: PtrInt);
31 function StateToStr(State: TTransactionState): string;
32 function AdviseToStr(Advise: TTransactionAdvise): string;
33 function ActionToStr(anAction: TTransactionAction): string;
34 procedure RunGFix;
35 public
36 { public declarations }
37 end;
38
39 var
40 LimboTransactionsForm: TLimboTransactionsForm;
41
42 implementation
43
44 {$R *.lfm}
45
46 uses Unit1;
47
48 { TLimboTransactionsForm }
49
50 procedure TLimboTransactionsForm.FormShow(Sender: TObject);
51 begin
52 Application.QueueAsyncCall(@DoRefresh,0);
53 end;
54
55 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;
72
73 procedure TLimboTransactionsForm.Button4Click(Sender: TObject);
74 begin
75 IBValidationService1.GlobalAction := RecoverTwoPhaseGlobal;
76 RunGFix;
77 end;
78
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;
117 end;
118
119 function TLimboTransactionsForm.StateToStr(State: TTransactionState): string;
120 begin
121 case State of
122 LimboState:
123 Result := 'Limbo';
124 CommitState:
125 Result := 'Commit';
126 RollbackState:
127 Result := 'Rollback';
128 else
129 Result := 'Unknown';
130 end;
131 end;
132
133 function TLimboTransactionsForm.AdviseToStr(Advise: TTransactionAdvise): string;
134 begin
135 case Advise of
136 CommitAdvise:
137 Result := 'Commit';
138 RollbackAdvise:
139 Result := 'Rollback';
140 else
141 Result := 'Unknown';
142 end;
143 end;
144
145 function TLimboTransactionsForm.ActionToStr(anAction: TTransactionAction
146 ): string;
147 begin
148 case anAction of
149 CommitAction:
150 Result := 'Commit';
151 RollbackAction:
152 Result := 'Rollback';
153 end;
154 end;
155
156 procedure TLimboTransactionsForm.RunGFix;
157 begin
158 with IBValidationService1 do
159 begin
160 Form1.Memo1.Lines.Add('Starting Limbo transaction resolution');
161 FixLimboTransactionErrors;
162 while not Eof do
163 begin
164 Form1.Memo1.Lines.Add(GetNextLine);
165 Application.ProcessMessages;
166 end;
167 Form1.Memo1.Lines.Add('Limbo Transaction resolution complete');
168 Application.QueueAsyncCall(@DoRefresh,0);
169 end;
170 end;
171
172 end.
173