examples/services/LimboTransactionsUnit.pas

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;
    IBValidationService1: TIBValidationService;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    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 Unit1;

{ TLimboTransactionsForm }

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

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

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

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

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

procedure TLimboTransactionsForm.StringGrid1EditingDone(Sender: TObject);
begin
  with StringGrid1, IBValidationService1 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 IBValidationService1 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 IBValidationService1 do
  begin
    Form1.Memo1.Lines.Add('Starting Limbo transaction resolution');
    FixLimboTransactionErrors;
    while not Eof do
    begin
      Form1.Memo1.Lines.Add(GetNextLine);
      Application.ProcessMessages;
    end;
    Form1.Memo1.Lines.Add('Limbo Transaction resolution complete');
    Application.QueueAsyncCall(@DoRefresh,0);
  end;
end;

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	4208 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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