ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/services/LimboTransactionsUnit.pas
(Generate patch)

Comparing ibx/trunk/examples/services/LimboTransactionsUnit.pas (file contents):
Revision 146 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
Revision 147 by tony, Mon Feb 26 11:14:30 2018 UTC

# Line 32 | 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 +    Button5: TButton;
51 +    IBDynamicGrid3: TIBDynamicGrid;
52 +    InLimboList: TMemDataset;
53 +    Label38: TLabel;
54 +    Label39: TLabel;
55 +    LimboListSource: TDataSource;
56 +    LimboReport: TMemo;
57      LimboTransactionValidation: TIBValidationService;
58 <    Label1: TLabel;
59 <    StringGrid1: TStringGrid;
60 <    procedure Button1Click(Sender: TObject);
61 <    procedure Button2Click(Sender: TObject);
50 <    procedure Button3Click(Sender: TObject);
51 <    procedure Button4Click(Sender: TObject);
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);
58 –    function StateToStr(State: TTransactionState): string;
59 –    function AdviseToStr(Advise: TTransactionAdvise): string;
60 –    function ActionToStr(anAction: TTransactionAction): string;
72      procedure RunGFix;
73    public
74      { public declarations }
# Line 77 | Line 88 | uses MainFormUnit;
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);
83 < begin
84 <  LimboTransactionValidation.GlobalAction := CommitGlobal;
85 <  RunGFix;
86 < end;
87 <
88 < procedure TLimboTransactionsForm.Button2Click(Sender: TObject);
89 < begin
90 <  LimboTransactionValidation.GlobalAction := RollbackGlobal;
91 <  RunGFix;
92 < end;
93 <
94 < procedure TLimboTransactionsForm.Button3Click(Sender: TObject);
95 < begin
96 <  LimboTransactionValidation.GlobalAction := NoGlobalAction;
97 <  RunGFix;
98 < end;
99 <
100 < procedure TLimboTransactionsForm.Button4Click(Sender: TObject);
101 < begin
102 <  LimboTransactionValidation.GlobalAction := RecoverTwoPhaseGlobal;
103 <  RunGFix;
104 < end;
105 <
106 < procedure TLimboTransactionsForm.FormClose(Sender: TObject;
107 <  var CloseAction: TCloseAction);
108 < begin
109 < end;
110 <
111 < procedure TLimboTransactionsForm.StringGrid1EditingDone(Sender: TObject);
112 < begin
113 <  with StringGrid1, LimboTransactionValidation do
114 <  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;
94 > procedure TLimboTransactionsForm.InLimboListAfterOpen(DataSet: TDataSet);
95  
96 < procedure TLimboTransactionsForm.DoRefresh(Data: PtrInt);
125 < var i: integer;
96 > function TypeToStr(MultiDatabase: boolean): string;
97   begin
98 <  with LimboTransactionValidation do
99 <  begin
100 <    Active := true;
101 <    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;
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 162 | 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 174 | Line 127 | begin
127    end;
128   end;
129  
130 < function TLimboTransactionsForm.ActionToStr(anAction: TTransactionAction
178 <  ): string;
130 > function ActionToStr(anAction: IBServices.TTransactionAction): string;
131   begin
132    case anAction of
133    CommitAction:
# Line 185 | 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 +  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 <    MainForm.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 <      MainForm.Memo1.Lines.Add(GetNextLine);
249 >      LimboReport.Lines.Add(GetNextLine);
250        Application.ProcessMessages;
251      end;
252 <    MainForm.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