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 (8 years ago) by tony
Content type: text/x-pascal
File size: 4208 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# User Rev Content
1 tony 45 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