client/3.0/FB30Transaction.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FB30Transaction;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, Firebird, IB, FBClientAPI, FB30ClientAPI,
  FB30Attachment, FBParamBlock, FBActivityMonitor, FBTransaction;

type

  { TFB30Transaction }

  TFB30Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
  private
    FTransactionIntf: Firebird.ITransaction;
    FFirebird30ClientAPI: TFB30ClientAPI;
    procedure StartMultiple;
    procedure FreeHandle(Force: boolean);
  protected
    function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
    procedure SetInterface(api: TFBClientAPI); override;
    function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
  public
    destructor Destroy; override;
    property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
    {ITransaction}
    function GetInTransaction: boolean; override;
    procedure PrepareForCommit; override;
    procedure Commit(Force: boolean=false); override;
    procedure CommitRetaining; override;
    procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
    procedure Rollback(Force: boolean=false); override;
    procedure RollbackRetaining; override;
  end;


implementation

uses FBMessages;

{ TFB30Transaction }

procedure TFB30Transaction.StartMultiple;
var Dtc: IDtc;
    DtcStart: IDtcStart;
    i: integer;
begin
  with FFirebird30ClientAPI do
  begin
    Dtc := MasterIntf.getDtc;
    DtcStart := Dtc.startBuilder(StatusIntf);
    Check4DataBaseError;

    for i := 0 to Length(FAttachments) - 1 do
    if (FAttachments[i] <> nil)  then
    begin
      DTCStart.addWithTpb(StatusIntf,
                          (FAttachments[i] as TFB30Attachment).AttachmentIntf,
                          (FTPB as TTPB).getDataLength,
                          BytePtr((FTPB as TTPB).getBuffer));
      Check4DataBaseError;
    end;
    FTransactionIntf := DtcStart.start(StatusIntf);
    Check4DataBaseError;
  end;
end;

procedure TFB30Transaction.FreeHandle(Force: boolean);
begin
  if assigned(FTransactionIntf) then
  try
    FTransactionIntf.release;
  except
    if not Force then raise;
    {else ignore if Force = true}
  end;
  FTransactionIntf := nil;
end;

function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
begin
  att.QueryInterface(IActivityMonitor,Result);
end;

procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
begin
  inherited SetInterface(api);
  FFirebird30ClientAPI := api as TFB30ClientAPI;
end;

function TFB30Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
  ): ITrInformation;
begin
  Result := TTrInformation.Create(FFirebird30ClientAPI);
  with FFirebird30ClientAPI, Result as TTrInformation do
  begin
    FTransactionIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
                               getBufSize, BytePtr(Buffer));
    Check4DataBaseError;
  end
end;

destructor TFB30Transaction.Destroy;
begin
  inherited Destroy;
  FreeHandle(true);
end;

function TFB30Transaction.GetInTransaction: boolean;
begin
  Result := FTransactionIntf <> nil;
end;

procedure TFB30Transaction.PrepareForCommit;
begin
  if Length(FAttachments) < 2 then
    IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.prepare(StatusIntf,0,nil);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

procedure TFB30Transaction.Commit(Force: boolean);
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.commit(StatusIntf);
    if not Force and InErrorState then
       IBDataBaseError;
  end;
  SignalActivity;
  FreeHandle(Force);
end;

procedure TFB30Transaction.CommitRetaining;
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.commitRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

procedure TFB30Transaction.Start(DefaultCompletion: TTransactionCompletion);
begin
  if FTransactionIntf <> nil then
    Exit;
  FDefaultCompletion := DefaultCompletion;

  if Length(FAttachments) = 1 then
    with FFirebird30ClientAPI do
    begin
      FTransactionIntf  := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
               (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
      Check4DataBaseError;
    end
  else
    StartMultiple;
  SignalActivity;
  Inc(FSeqNo);
end;

procedure TFB30Transaction.Rollback(Force: boolean);
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.rollback(StatusIntf);
    if not Force and InErrorState then
       IBDataBaseError;
  end;
  SignalActivity;
  FreeHandle(Force);
end;

procedure TFB30Transaction.RollbackRetaining;
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.rollbackRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
end;


end.

Revision:	359
Committed:	Tue Dec 7 09:37:32 2021 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	6052 byte(s)
Log Message:	Fixes Merged
#	Content
1	(*
2	* Firebird Interface (fbintf). The fbintf components provide a set of
3	* Pascal language bindings for the Firebird API.
4	*
5	* The contents of this file are subject to the Initial Developer's
6	* Public License Version 1.0 (the "License"); you may not use this
7	* file except in compliance with the License. You may obtain a copy
8	* of the License here:
9	*
10	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11	*
12	* Software distributed under the License is distributed on an "AS
13	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14	* implied. See the License for the specific language governing rights
15	* and limitations under the License.
16	*
17	* The Initial Developer of the Original Code is Tony Whyman.
18	*
19	* The Original Code is (C) 2016 Tony Whyman, MWA Software
20	* (http://www.mwasoftware.co.uk).
21	*
22	* All Rights Reserved.
23	*
24	* Contributor(s): ______________________________________.
25	*
26	*)
27	unit FB30Transaction;
28	{$IFDEF MSWINDOWS}
29	{$DEFINE WINDOWS}
30	{$ENDIF}
31
32	{$IFDEF FPC}
33	{$mode delphi}
34	{$interfaces COM}
35	{$ENDIF}
36
37	interface
38
39	uses
40	Classes, SysUtils, Firebird, IB, FBClientAPI, FB30ClientAPI,
41	FB30Attachment, FBParamBlock, FBActivityMonitor, FBTransaction;
42
43	type
44
45	{ TFB30Transaction }
46
47	TFB30Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
48	private
49	FTransactionIntf: Firebird.ITransaction;
50	FFirebird30ClientAPI: TFB30ClientAPI;
51	procedure StartMultiple;
52	procedure FreeHandle(Force: boolean);
53	protected
54	function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
55	procedure SetInterface(api: TFBClientAPI); override;
56	function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
57	public
58	destructor Destroy; override;
59	property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
60	{ITransaction}
61	function GetInTransaction: boolean; override;
62	procedure PrepareForCommit; override;
63	procedure Commit(Force: boolean=false); override;
64	procedure CommitRetaining; override;
65	procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
66	procedure Rollback(Force: boolean=false); override;
67	procedure RollbackRetaining; override;
68	end;
69
70
71	implementation
72
73	uses FBMessages;
74
75	{ TFB30Transaction }
76
77	procedure TFB30Transaction.StartMultiple;
78	var Dtc: IDtc;
79	DtcStart: IDtcStart;
80	i: integer;
81	begin
82	with FFirebird30ClientAPI do
83	begin
84	Dtc := MasterIntf.getDtc;
85	DtcStart := Dtc.startBuilder(StatusIntf);
86	Check4DataBaseError;
87
88	for i := 0 to Length(FAttachments) - 1 do
89	if (FAttachments[i] <> nil) then
90	begin
91	DTCStart.addWithTpb(StatusIntf,
92	(FAttachments[i] as TFB30Attachment).AttachmentIntf,
93	(FTPB as TTPB).getDataLength,
94	BytePtr((FTPB as TTPB).getBuffer));
95	Check4DataBaseError;
96	end;
97	FTransactionIntf := DtcStart.start(StatusIntf);
98	Check4DataBaseError;
99	end;
100	end;
101
102	procedure TFB30Transaction.FreeHandle(Force: boolean);
103	begin
104	if assigned(FTransactionIntf) then
105	try
106	FTransactionIntf.release;
107	except
108	if not Force then raise;
109	{else ignore if Force = true}
110	end;
111	FTransactionIntf := nil;
112	end;
113
114	function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
115	begin
116	att.QueryInterface(IActivityMonitor,Result);
117	end;
118
119	procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
120	begin
121	inherited SetInterface(api);
122	FFirebird30ClientAPI := api as TFB30ClientAPI;
123	end;
124
125	function TFB30Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
126	): ITrInformation;
127	begin
128	Result := TTrInformation.Create(FFirebird30ClientAPI);
129	with FFirebird30ClientAPI, Result as TTrInformation do
130	begin
131	FTransactionIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
132	getBufSize, BytePtr(Buffer));
133	Check4DataBaseError;
134	end
135	end;
136
137	destructor TFB30Transaction.Destroy;
138	begin
139	inherited Destroy;
140	FreeHandle(true);
141	end;
142
143	function TFB30Transaction.GetInTransaction: boolean;
144	begin
145	Result := FTransactionIntf <> nil;
146	end;
147
148	procedure TFB30Transaction.PrepareForCommit;
149	begin
150	if Length(FAttachments) < 2 then
151	IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
152	if FTransactionIntf = nil then
153	Exit;
154	with FFirebird30ClientAPI do
155	begin
156	FTransactionIntf.prepare(StatusIntf,0,nil);
157	Check4DataBaseError;
158	end;
159	SignalActivity;
160	end;
161
162	procedure TFB30Transaction.Commit(Force: boolean);
163	begin
164	if FTransactionIntf = nil then
165	Exit;
166	with FFirebird30ClientAPI do
167	begin
168	FTransactionIntf.commit(StatusIntf);
169	if not Force and InErrorState then
170	IBDataBaseError;
171	end;
172	SignalActivity;
173	FreeHandle(Force);
174	end;
175
176	procedure TFB30Transaction.CommitRetaining;
177	begin
178	if FTransactionIntf = nil then
179	Exit;
180	with FFirebird30ClientAPI do
181	begin
182	FTransactionIntf.commitRetaining(StatusIntf);
183	Check4DataBaseError;
184	end;
185	SignalActivity;
186	end;
187
188	procedure TFB30Transaction.Start(DefaultCompletion: TTransactionCompletion);
189	begin
190	if FTransactionIntf <> nil then
191	Exit;
192	FDefaultCompletion := DefaultCompletion;
193
194	if Length(FAttachments) = 1 then
195	with FFirebird30ClientAPI do
196	begin
197	FTransactionIntf := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
198	(FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
199	Check4DataBaseError;
200	end
201	else
202	StartMultiple;
203	SignalActivity;
204	Inc(FSeqNo);
205	end;
206
207	procedure TFB30Transaction.Rollback(Force: boolean);
208	begin
209	if FTransactionIntf = nil then
210	Exit;
211	with FFirebird30ClientAPI do
212	begin
213	FTransactionIntf.rollback(StatusIntf);
214	if not Force and InErrorState then
215	IBDataBaseError;
216	end;
217	SignalActivity;
218	FreeHandle(Force);
219	end;
220
221	procedure TFB30Transaction.RollbackRetaining;
222	begin
223	if FTransactionIntf = nil then
224	Exit;
225	with FFirebird30ClientAPI do
226	begin
227	FTransactionIntf.rollbackRetaining(StatusIntf);
228	Check4DataBaseError;
229	end;
230	SignalActivity;
231	end;
232
233
234	end.
235