ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBTransaction.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBTransaction.pas
File size: 11078 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# 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. 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 FBTransaction;
63 tony 56 {$IFDEF MSWINDOWS}
64     {$DEFINE WINDOWS}
65     {$ENDIF}
66 tony 45
67     {$IFDEF FPC}
68 tony 56 {$mode delphi}
69 tony 45 {$interfaces COM}
70     {$ENDIF}
71    
72     interface
73    
74     uses
75 tony 263 Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
76 tony 45
77     type
78     { TFBTransaction }
79    
80     TFBTransaction = class(TActivityReporter, IActivityMonitor,ITransaction)
81     private
82 tony 263 FFirebirdAPI: TFBClientAPI;
83 tony 45 function GenerateTPB(sl: array of byte): ITPB;
84     protected
85     FTPB: ITPB;
86     FSeqNo: integer;
87     FDefaultCompletion: TTransactionAction;
88     FAttachments: array of IAttachment; {Keep reference to attachment - ensures
89     attachment cannot be freed before transaction}
90     function GetActivityIntf(att: IAttachment): IActivityMonitor; virtual; abstract;
91 tony 263 procedure SetInterface(api: TFBClientAPI); virtual;
92 tony 45 public
93 tony 263 constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
94     constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
95     constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
96     constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
97 tony 45 destructor Destroy; override;
98     procedure DoDefaultTransactionEnd(Force: boolean);
99 tony 263 property FirebirdAPI: TFBClientAPI read FFirebirdAPI;
100 tony 45
101     public
102     {ITransaction}
103     function getTPB: ITPB;
104     procedure PrepareForCommit;virtual; abstract;
105     procedure Commit(Force: boolean=false); virtual; abstract;
106     procedure CommitRetaining; virtual; abstract;
107     function GetInTransaction: boolean; virtual; abstract;
108     function GetAttachmentCount: integer;
109     function GetAttachment(index: integer): IAttachment;
110     procedure Rollback(Force: boolean=false); virtual; abstract;
111     procedure RollbackRetaining; virtual; abstract;
112     procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; virtual; abstract;
113     procedure Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit); overload;
114    
115     property InTransaction: boolean read GetInTransaction;
116     property TransactionSeqNo: integer read FSeqNo;
117     end;
118    
119 tony 315 {The transaction user interface is used to force an action on the end of the
120     transaction.}
121    
122     ITransactionUser = interface
123     ['{156fcdc9-a326-44b3-a82d-f23c6fb9f97c}']
124     procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
125     end;
126    
127     { TTPBItem }
128    
129     TTPBItem = class(TParamBlockItem,ITPBItem)
130     public
131     function getParamTypeName: AnsiString; override;
132     end;
133    
134     { TTPB }
135    
136     TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
137     protected
138     function LookupItemType(ParamTypeName: AnsiString): byte; override;
139     public
140     constructor Create(api: TFBClientAPI);
141     function GetDPBParamTypeName(ParamType: byte): Ansistring;
142     end;
143    
144 tony 45 implementation
145    
146 tony 315 uses FBMessages;
147 tony 45
148 tony 315 const
149     isc_tpb_last_tpb_constant = isc_tpb_at_snapshot_number;
150    
151     TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
152     'consistency',
153     'concurrency',
154     'shared',
155     'protected',
156     'exclusive',
157     'wait',
158     'nowait',
159     'read',
160     'write',
161     'lock_read',
162     'lock_write',
163     'verb_time',
164     'commit_time',
165     'ignore_limbo',
166     'read_committed',
167     'autocommit',
168     'rec_version',
169     'no_rec_version',
170     'restart_requests',
171     'no_auto_undo',
172     'lock_timeout',
173     'read_consistency',
174     'at_snapshot_number'
175     );
176    
177 tony 45 { TFBTransaction }
178    
179     function TFBTransaction.GenerateTPB(sl: array of byte): ITPB;
180     var
181     i: Integer;
182     begin
183 tony 263 Result := TTPB.Create(FFirebirdAPI);
184 tony 45 for i := 0 to Length(sl) - 1 do
185     Result.Add(sl[i]);
186     end;
187    
188 tony 263 procedure TFBTransaction.SetInterface(api: TFBClientAPI);
189     begin
190     FFirebirdAPI := api;
191     end;
192    
193     constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment;
194 tony 45 Params: array of byte; DefaultCompletion: TTransactionAction);
195     begin
196 tony 263 Create(api, Attachments,GenerateTPB(Params), DefaultCompletion);
197 tony 45 end;
198    
199 tony 263 constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB;
200 tony 45 DefaultCompletion: TTransactionAction);
201     var
202     i: Integer;
203     begin
204     inherited Create(nil);
205 tony 263 SetInterface(api);
206 tony 45 if Length(Attachments) = 0 then
207     IBError(ibxeEmptyAttachmentsList,[nil]);
208    
209 tony 263 {make sure all attachments use same Firebird API}
210     for i := 0 to Length(Attachments) - 1 do
211     if Attachments[i].getFirebirdAPI.GetFBLibrary.GetHandle <> FFirebirdAPI.GetFBLibrary.GetHandle then
212     IBError(ibxeDifferentAPIs,[nil]);
213    
214 tony 45 SetLength(FAttachments,Length(Attachments));
215     for i := 0 to Length(Attachments) - 1 do
216     begin
217     AddMonitor(GetActivityIntf(Attachments[i]));
218     FAttachments[i] := Attachments[i];
219     end;
220     FTPB := TPB;
221     Start(DefaultCompletion);
222     end;
223    
224 tony 263 constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment;
225 tony 45 Params: array of byte; DefaultCompletion: TTransactionAction);
226     begin
227 tony 263 Create(api,Attachment,GenerateTPB(Params),DefaultCompletion);
228 tony 45 end;
229    
230 tony 263 constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB;
231 tony 45 DefaultCompletion: TTransactionAction);
232     begin
233     inherited Create(nil);
234 tony 263 SetInterface(api);
235 tony 45 AddMonitor(GetActivityIntf(Attachment));
236     SetLength(FAttachments,1);
237     FAttachments[0] := Attachment;
238     FTPB := TPB;
239     Start(DefaultCompletion);
240     end;
241    
242     destructor TFBTransaction.Destroy;
243     begin
244     DoDefaultTransactionEnd(false);
245     inherited Destroy;
246     end;
247    
248     procedure TFBTransaction.DoDefaultTransactionEnd(Force: boolean);
249     var i: integer;
250 tony 315 intf: IUnknown;
251     user: ITransactionUser;
252 tony 45 begin
253     if InTransaction then
254     begin
255     for i := 0 to InterfaceCount - 1 do
256     begin
257     intf := GetInterface(i);
258 tony 315 if (intf <> nil) and (intf.QueryInterface(ITransactionUser,user) = S_OK) then
259     user.TransactionEnding(self,Force);
260 tony 45 end;
261     case FDefaultCompletion of
262     taRollback:
263     Rollback(Force);
264     taCommit:
265     Commit(Force);
266     end;
267     end;
268     end;
269    
270     function TFBTransaction.getTPB: ITPB;
271     begin
272     Result := FTPB;
273     end;
274    
275     function TFBTransaction.GetAttachmentCount: integer;
276     begin
277     Result := Length(FAttachments);
278     end;
279    
280     function TFBTransaction.GetAttachment(index: integer): IAttachment;
281     begin
282     if (index >= 0) and (index < Length(FAttachments)) then
283     Result := FAttachments[index]
284     else
285     IBError(ibxeAttachmentListIndexError,[index]);
286     end;
287    
288     procedure TFBTransaction.Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion
289     );
290     begin
291     FTPB := TPB;
292     Start(DefaultCompletion);
293     end;
294    
295 tony 315 { TTPBItem }
296    
297     function TTPBItem.getParamTypeName: AnsiString;
298     begin
299     Result := TPBPrefix + TPBConstantNames[getParamType];
300     end;
301    
302    
303     {TTPB}
304    
305     constructor TTPB.Create(api: TFBClientAPI);
306     begin
307     inherited Create(api);
308     FDataLength := 1;
309     FBuffer^ := isc_tpb_version3;
310     end;
311    
312     function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
313     begin
314     if ParamType <= isc_tpb_last_tpb_constant then
315     Result := TPBConstantNames[ParamType]
316     else
317     Result := '';
318     end;
319    
320     function TTPB.LookupItemType(ParamTypeName: AnsiString): byte;
321     var i: byte;
322     begin
323     Result := 0;
324     ParamTypeName := LowerCase(ParamTypeName);
325     if (Pos(TPBPrefix, ParamTypeName) = 1) then
326     Delete(ParamTypeName, 1, Length(TPBPrefix));
327    
328     for i := 1 to isc_tpb_last_tpb_constant do
329     if (ParamTypeName = TPBConstantNames[i]) then
330     begin
331     Result := i;
332     break;
333     end;
334     end;
335    
336 tony 45 end.
337