ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/2.5/FB25Transaction.pas
Revision: 359
Committed: Tue Dec 7 09:37:32 2021 UTC (2 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Transaction.pas
File size: 7972 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 (*
2 * Firebird Interface (fbintf). The fbintf components provide a set of
3 * Pascal language bindings for the Firebird API. Although predominantly
4 * a new development they include source code taken from IBX and may be
5 * considered a derived product. This software thus also includes the copyright
6 * notice and license conditions from IBX.
7 *
8 * Except for those parts dervied from IBX, contents of this file are subject
9 * to the Initial Developer's Public License Version 1.0 (the "License"); you
10 * may not use this file except in compliance with the License. You may obtain a
11 * copy of the License here:
12 *
13 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
14 *
15 * Software distributed under the License is distributed on an "AS
16 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17 * implied. See the License for the specific language governing rights
18 * and limitations under the License.
19 *
20 * The Initial Developer of the Original Code is Tony Whyman.
21 *
22 * The Original Code is (C) 2016 Tony Whyman, MWA Software
23 * (http://www.mwasoftware.co.uk).
24 *
25 * All Rights Reserved.
26 *
27 * Contributor(s): ______________________________________.
28 *
29 *)
30 {************************************************************************}
31 { }
32 { Borland Delphi Visual Component Library }
33 { InterBase Express core components }
34 { }
35 { Copyright (c) 1998-2000 Inprise Corporation }
36 { }
37 { InterBase Express is based in part on the product }
38 { Free IB Components, written by Gregory H. Deatz for }
39 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
40 { Free IB Components is used under license. }
41 { }
42 { The contents of this file are subject to the InterBase }
43 { Public License Version 1.0 (the "License"); you may not }
44 { use this file except in compliance with the License. You }
45 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46 { Software distributed under the License is distributed on }
47 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48 { express or implied. See the License for the specific language }
49 { governing rights and limitations under the License. }
50 { The Original Code was created by InterBase Software Corporation }
51 { and its successors. }
52 { Portions created by Inprise Corporation are Copyright (C) Inprise }
53 { Corporation. All Rights Reserved. }
54 { Contributor(s): Jeff Overcash }
55 { }
56 { IBX For Lazarus (Firebird Express) }
57 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58 { Portions created by MWA Software are copyright McCallum Whyman }
59 { Associates Ltd 2011 - 2015 }
60 { }
61 {************************************************************************}
62 unit FB25Transaction;
63 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$interfaces COM}
70 {$ENDIF}
71 {$R-}
72
73 interface
74
75 uses
76 Classes, SysUtils, IB, FBClientAPI, FB25ClientAPI, IBHeader,
77 FB25Attachment, FBActivityMonitor, FBTransaction;
78
79 type
80 { TFB25Transaction }
81
82 TFB25Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
83 private
84 FHandle: TISC_TR_HANDLE;
85 FFirebird25ClientAPI: TFB25ClientAPI;
86 protected
87 function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
88 function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
89 procedure SetInterface(api: TFBClientAPI); override;
90 public
91 property Handle: TISC_TR_HANDLE read FHandle;
92
93 public
94 {ITransaction}
95 function GetInTransaction: boolean; override;
96 procedure PrepareForCommit; override;
97 procedure Commit(Force: boolean=false); override;
98 procedure CommitRetaining; override;
99 procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
100 procedure Rollback(Force: boolean=false); override;
101 procedure RollbackRetaining; override;
102 end;
103
104 implementation
105
106 uses FBMessages, FBParamBlock;
107
108 { TFB25Transaction }
109
110 function TFB25Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
111 begin
112 Result := (att as TFB25Attachment);
113 end;
114
115 function TFB25Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
116 ): ITrInformation;
117 begin
118 Result := TTrInformation.Create(FFirebird25ClientAPI);
119 with FFirebird25ClientAPI, Result as TTrInformation do
120 if isc_transaction_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
121 getBufSize, Buffer) > 0 then
122 IBDataBaseError;
123 end;
124
125 procedure TFB25Transaction.SetInterface(api: TFBClientAPI);
126 begin
127 inherited SetInterface(api);
128 FFirebird25ClientAPI := api as TFB25ClientAPI;
129 OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
130 end;
131
132 function TFB25Transaction.GetInTransaction: boolean;
133 begin
134 Result := FHandle <> nil;
135 end;
136
137 procedure TFB25Transaction.PrepareForCommit;
138 begin
139 if Length(FAttachments) < 2 then
140 IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
141 if FHandle = nil then
142 Exit;
143 with FFirebird25ClientAPI do
144 Call(isc_prepare_transaction(StatusVector, @FHandle));
145 end;
146
147 procedure TFB25Transaction.Commit(Force: boolean);
148 begin
149 if FHandle = nil then
150 Exit;
151 with FFirebird25ClientAPI do
152 Call(isc_commit_transaction(StatusVector, @FHandle),not Force);
153 FHandle := nil;
154 end;
155
156 procedure TFB25Transaction.CommitRetaining;
157 begin
158 if FHandle = nil then
159 Exit;
160 with FFirebird25ClientAPI do
161 Call(isc_commit_retaining(StatusVector, @FHandle));
162 end;
163
164 procedure TFB25Transaction.Start(DefaultCompletion: TTransactionCompletion);
165 var pteb: PISC_TEB_ARRAY;
166 i: integer;
167 db_handle: TISC_DB_HANDLE;
168 begin
169 if FHandle <> nil then
170 Exit;
171 pteb := nil;
172 FDefaultCompletion := DefaultCompletion;
173 with FFirebird25ClientAPI do
174 if (Length(FAttachments) = 1) then
175 try
176 db_handle := (FAttachments[0] as TFB25Attachment).Handle;
177 Call(isc_start_transaction(StatusVector, @FHandle,1,
178 @db_handle,(FTPB as TTPB).getDataLength,(FTPB as TTPB).getBuffer));
179 except
180 FHandle := nil;
181 raise;
182 end
183 else
184 begin
185 IBAlloc(pteb, 0, Length(FAttachments) * SizeOf(TISC_TEB));
186 try
187 for i := 0 to Length(FAttachments) - 1 do
188 if (FAttachments[i] <> nil) then
189 begin
190 pteb^[i].db_handle := @((FAttachments[i] as TFB25Attachment).Handle);
191 pteb^[i].tpb_length := (FTPB as TTPB).getDataLength;
192 pteb^[i].tpb_address := (FTPB as TTPB).getBuffer;
193 end;
194 try
195 Call(isc_start_multiple(StatusVector, @FHandle,
196 Length(FAttachments), PISC_TEB(pteb)));
197 except
198 FHandle := nil;
199 raise;
200 end;
201 finally
202 FreeMem(pteb);
203 end;
204 end;
205 Inc(FSeqNo);
206 end;
207
208 procedure TFB25Transaction.Rollback(Force: boolean);
209 begin
210 if FHandle = nil then
211 Exit;
212 with FFirebird25ClientAPI do
213 Call(isc_rollback_transaction(StatusVector, @FHandle),not Force);
214 FHandle := nil;
215 end;
216
217 procedure TFB25Transaction.RollbackRetaining;
218 begin
219 if FHandle = nil then
220 Exit;
221 with FFirebird25ClientAPI do
222 Call(isc_rollback_retaining(StatusVector, @FHandle));
223 end;
224
225 end.
226