ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBTransaction.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 8969 byte(s)
Log Message:
Release 2.3.2 committed

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 FBTransaction;
63 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$interfaces COM}
70 {$ENDIF}
71
72 interface
73
74 uses
75 Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
76
77 type
78 { TFBTransaction }
79
80 TFBTransaction = class(TActivityReporter, IActivityMonitor,ITransaction)
81 private
82 FFirebirdAPI: TFBClientAPI;
83 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 procedure SetInterface(api: TFBClientAPI); virtual;
92 public
93 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 destructor Destroy; override;
98 procedure DoDefaultTransactionEnd(Force: boolean);
99 property FirebirdAPI: TFBClientAPI read FFirebirdAPI;
100
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 implementation
120
121 uses FBMessages, FBStatement;
122
123 { TFBTransaction }
124
125 function TFBTransaction.GenerateTPB(sl: array of byte): ITPB;
126 var
127 i: Integer;
128 begin
129 Result := TTPB.Create(FFirebirdAPI);
130 for i := 0 to Length(sl) - 1 do
131 Result.Add(sl[i]);
132 end;
133
134 procedure TFBTransaction.SetInterface(api: TFBClientAPI);
135 begin
136 FFirebirdAPI := api;
137 end;
138
139 constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment;
140 Params: array of byte; DefaultCompletion: TTransactionAction);
141 begin
142 Create(api, Attachments,GenerateTPB(Params), DefaultCompletion);
143 end;
144
145 constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB;
146 DefaultCompletion: TTransactionAction);
147 var
148 i: Integer;
149 begin
150 inherited Create(nil);
151 SetInterface(api);
152 if Length(Attachments) = 0 then
153 IBError(ibxeEmptyAttachmentsList,[nil]);
154
155 {make sure all attachments use same Firebird API}
156 for i := 0 to Length(Attachments) - 1 do
157 if Attachments[i].getFirebirdAPI.GetFBLibrary.GetHandle <> FFirebirdAPI.GetFBLibrary.GetHandle then
158 IBError(ibxeDifferentAPIs,[nil]);
159
160 SetLength(FAttachments,Length(Attachments));
161 for i := 0 to Length(Attachments) - 1 do
162 begin
163 AddMonitor(GetActivityIntf(Attachments[i]));
164 FAttachments[i] := Attachments[i];
165 end;
166 FTPB := TPB;
167 Start(DefaultCompletion);
168 end;
169
170 constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment;
171 Params: array of byte; DefaultCompletion: TTransactionAction);
172 begin
173 Create(api,Attachment,GenerateTPB(Params),DefaultCompletion);
174 end;
175
176 constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB;
177 DefaultCompletion: TTransactionAction);
178 begin
179 inherited Create(nil);
180 SetInterface(api);
181 AddMonitor(GetActivityIntf(Attachment));
182 SetLength(FAttachments,1);
183 FAttachments[0] := Attachment;
184 FTPB := TPB;
185 Start(DefaultCompletion);
186 end;
187
188 destructor TFBTransaction.Destroy;
189 begin
190 DoDefaultTransactionEnd(false);
191 inherited Destroy;
192 end;
193
194 procedure TFBTransaction.DoDefaultTransactionEnd(Force: boolean);
195 var i: integer;
196 intf: TInterfacedObject;
197 begin
198 if InTransaction then
199 begin
200 for i := 0 to InterfaceCount - 1 do
201 begin
202 intf := GetInterface(i);
203 if (intf <> nil) and (intf is TFBStatement) then
204 TFBStatement(intf).TransactionEnding(self,Force);
205 end;
206 case FDefaultCompletion of
207 taRollback:
208 Rollback(Force);
209 taCommit:
210 Commit(Force);
211 end;
212 end;
213 end;
214
215 function TFBTransaction.getTPB: ITPB;
216 begin
217 Result := FTPB;
218 end;
219
220 function TFBTransaction.GetAttachmentCount: integer;
221 begin
222 Result := Length(FAttachments);
223 end;
224
225 function TFBTransaction.GetAttachment(index: integer): IAttachment;
226 begin
227 if (index >= 0) and (index < Length(FAttachments)) then
228 Result := FAttachments[index]
229 else
230 IBError(ibxeAttachmentListIndexError,[index]);
231 end;
232
233 procedure TFBTransaction.Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion
234 );
235 begin
236 FTPB := TPB;
237 Start(DefaultCompletion);
238 end;
239
240 end.
241