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