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 FreeHandle(Force: boolean);
  protected
    function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
    procedure SetInterface(api: TFBClientAPI); override;
    function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
    procedure InternalStartSingle(attachment: IAttachment); override;
    procedure InternalStartMultiple; override;
    function InternalCommit(Force: boolean): TTrCompletionState; override;
    procedure InternalCommitRetaining; override;
    function InternalRollback(Force: boolean): TTrCompletionState; override;
    procedure InternalRollbackRetaining; override;
  public
    constructor Create(api: TFBClientAPI; Attachment: IAttachment; aTransactionIntf: Firebird.ITransaction); overload;
    destructor Destroy; override;
    property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
    {ITransaction}
    function GetInTransaction: boolean; override;
    procedure PrepareForCommit; override;
  end;


implementation

uses FBMessages;

{ TFB30Transaction }

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;

procedure TFB30Transaction.InternalStartSingle(attachment: IAttachment);
begin
  if FTransactionIntf = nil then
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf  := (attachment as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
             (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
    Check4DataBaseError;
    FTransactionIntf.addRef();
  end;
  SignalActivity;
end;

procedure TFB30Transaction.InternalStartMultiple;
var Dtc: IDtc;
    DtcStart: IDtcStart;
    i: integer;
begin
  if FTransactionIntf = nil then
  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;
    FTransactionIntf.addRef();
    SignalActivity;
  end;
end;

function TFB30Transaction.InternalCommit(Force: boolean): TTrCompletionState;
begin
  with FFirebird30ClientAPI do
  begin
    Result := trCommitted;
    FTransactionIntf.commit(StatusIntf);
    if InErrorState then
    begin
      if Force then
        Result := trCommitFailed
      else
       IBDataBaseError;
    end;
  end;
  SignalActivity;
  FreeHandle(Force);
end;

procedure TFB30Transaction.InternalCommitRetaining;
begin
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.commitRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

function TFB30Transaction.InternalRollback(Force: boolean): TTrCompletionState;
begin
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.rollback(StatusIntf);
    Result := trRolledback;
    if InErrorState then
    begin
      if Force then
        Result := trRollbackFailed
      else
       IBDataBaseError;
    end;
  end;
  SignalActivity;
  FreeHandle(Force);
end;

procedure TFB30Transaction.InternalRollbackRetaining;
begin
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.rollbackRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

constructor TFB30Transaction.Create(api: TFBClientAPI; Attachment: IAttachment;
  aTransactionIntf: Firebird.ITransaction);
begin
  FTransactionIntf := aTransactionIntf;
  FTransactionIntf.addRef();
  FForeignHandle := true;
  inherited Create(api,Attachment,nil,taCommit,'');
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;


end.

Revision:	387
Committed:	Wed Jan 19 13:34:42 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	6573 byte(s)
Log Message:	Transactions started within a UDR are not forcibly closed if still active immediately prior to UDR exit
#	User	Rev	Content
1	tony	45	(*
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	tony	56	{$IFDEF MSWINDOWS}
29			{$DEFINE WINDOWS}
30			{$ENDIF}
31	tony	45
32			{$IFDEF FPC}
33	tony	56	{$mode delphi}
34	tony	45	{$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	tony	263	FFirebird30ClientAPI: TFB30ClientAPI;
51	tony	359	procedure FreeHandle(Force: boolean);
52	tony	45	protected
53			function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
54	tony	263	procedure SetInterface(api: TFBClientAPI); override;
55	tony	359	function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
56	tony	363	procedure InternalStartSingle(attachment: IAttachment); override;
57			procedure InternalStartMultiple; override;
58	tony	387	function InternalCommit(Force: boolean): TTrCompletionState; override;
59	tony	363	procedure InternalCommitRetaining; override;
60	tony	387	function InternalRollback(Force: boolean): TTrCompletionState; override;
61	tony	363	procedure InternalRollbackRetaining; override;
62	tony	45	public
63	tony	371	constructor Create(api: TFBClientAPI; Attachment: IAttachment; aTransactionIntf: Firebird.ITransaction); overload;
64	tony	45	destructor Destroy; override;
65			property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
66			{ITransaction}
67			function GetInTransaction: boolean; override;
68			procedure PrepareForCommit; override;
69			end;
70
71
72			implementation
73
74			uses FBMessages;
75
76			{ TFB30Transaction }
77
78	tony	359	procedure TFB30Transaction.FreeHandle(Force: boolean);
79	tony	45	begin
80			if assigned(FTransactionIntf) then
81	tony	359	try
82	tony	45	FTransactionIntf.release;
83	tony	359	except
84			if not Force then raise;
85			{else ignore if Force = true}
86			end;
87	tony	45	FTransactionIntf := nil;
88			end;
89
90			function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
91			begin
92	tony	315	att.QueryInterface(IActivityMonitor,Result);
93	tony	45	end;
94
95	tony	263	procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
96			begin
97			inherited SetInterface(api);
98			FFirebird30ClientAPI := api as TFB30ClientAPI;
99			end;
100
101	tony	359	function TFB30Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
102			): ITrInformation;
103			begin
104			Result := TTrInformation.Create(FFirebird30ClientAPI);
105			with FFirebird30ClientAPI, Result as TTrInformation do
106			begin
107			FTransactionIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
108			getBufSize, BytePtr(Buffer));
109			Check4DataBaseError;
110			end
111			end;
112
113	tony	363	procedure TFB30Transaction.InternalStartSingle(attachment: IAttachment);
114	tony	45	begin
115	tony	371	if FTransactionIntf = nil then
116	tony	363	with FFirebird30ClientAPI do
117			begin
118			FTransactionIntf := (attachment as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
119			(FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
120			Check4DataBaseError;
121	tony	371	FTransactionIntf.addRef();
122	tony	363	end;
123			SignalActivity;
124	tony	45	end;
125
126	tony	363	procedure TFB30Transaction.InternalStartMultiple;
127			var Dtc: IDtc;
128			DtcStart: IDtcStart;
129			i: integer;
130	tony	45	begin
131	tony	371	if FTransactionIntf = nil then
132	tony	263	with FFirebird30ClientAPI do
133	tony	45	begin
134	tony	363	Dtc := MasterIntf.getDtc;
135			DtcStart := Dtc.startBuilder(StatusIntf);
136	tony	45	Check4DataBaseError;
137	tony	363
138			for i := 0 to Length(FAttachments) - 1 do
139			if (FAttachments[i] <> nil) then
140			begin
141			DTCStart.addWithTpb(StatusIntf,
142			(FAttachments[i] as TFB30Attachment).AttachmentIntf,
143			(FTPB as TTPB).getDataLength,
144			BytePtr((FTPB as TTPB).getBuffer));
145			Check4DataBaseError;
146			end;
147
148			FTransactionIntf := DtcStart.start(StatusIntf);
149			Check4DataBaseError;
150	tony	371	FTransactionIntf.addRef();
151	tony	363	SignalActivity;
152	tony	45	end;
153			end;
154
155	tony	387	function TFB30Transaction.InternalCommit(Force: boolean): TTrCompletionState;
156	tony	45	begin
157	tony	263	with FFirebird30ClientAPI do
158	tony	45	begin
159	tony	387	Result := trCommitted;
160	tony	45	FTransactionIntf.commit(StatusIntf);
161	tony	387	if InErrorState then
162			begin
163			if Force then
164			Result := trCommitFailed
165			else
166	tony	45	IBDataBaseError;
167	tony	387	end;
168	tony	45	end;
169			SignalActivity;
170	tony	359	FreeHandle(Force);
171	tony	45	end;
172
173	tony	363	procedure TFB30Transaction.InternalCommitRetaining;
174	tony	45	begin
175	tony	263	with FFirebird30ClientAPI do
176	tony	45	begin
177			FTransactionIntf.commitRetaining(StatusIntf);
178			Check4DataBaseError;
179			end;
180			SignalActivity;
181			end;
182
183	tony	387	function TFB30Transaction.InternalRollback(Force: boolean): TTrCompletionState;
184	tony	45	begin
185	tony	263	with FFirebird30ClientAPI do
186	tony	45	begin
187			FTransactionIntf.rollback(StatusIntf);
188	tony	387	Result := trRolledback;
189			if InErrorState then
190			begin
191			if Force then
192			Result := trRollbackFailed
193			else
194	tony	45	IBDataBaseError;
195	tony	387	end;
196	tony	45	end;
197			SignalActivity;
198	tony	359	FreeHandle(Force);
199	tony	45	end;
200
201	tony	363	procedure TFB30Transaction.InternalRollbackRetaining;
202	tony	45	begin
203	tony	363	with FFirebird30ClientAPI do
204			begin
205			FTransactionIntf.rollbackRetaining(StatusIntf);
206			Check4DataBaseError;
207			end;
208			SignalActivity;
209			end;
210
211	tony	371	constructor TFB30Transaction.Create(api: TFBClientAPI; Attachment: IAttachment;
212			aTransactionIntf: Firebird.ITransaction);
213			begin
214			FTransactionIntf := aTransactionIntf;
215			FTransactionIntf.addRef();
216			FForeignHandle := true;
217			inherited Create(api,Attachment,nil,taCommit,'');
218			end;
219
220	tony	363	destructor TFB30Transaction.Destroy;
221			begin
222			inherited Destroy;
223			FreeHandle(true);
224			end;
225
226			function TFB30Transaction.GetInTransaction: boolean;
227			begin
228			Result := FTransactionIntf <> nil;
229			end;
230
231			procedure TFB30Transaction.PrepareForCommit;
232			begin
233			if Length(FAttachments) < 2 then
234			IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
235	tony	45	if FTransactionIntf = nil then
236			Exit;
237	tony	263	with FFirebird30ClientAPI do
238	tony	45	begin
239	tony	363	FTransactionIntf.prepare(StatusIntf,0,nil);
240	tony	45	Check4DataBaseError;
241			end;
242			SignalActivity;
243			end;
244
245
246			end.
247