ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBTransaction.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/FBTransaction.pas
File size: 8217 byte(s)
Log Message:
Committing updates for Release R2-0-0

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
64 {$IFDEF FPC}
65 {$mode objfpc}{$H+}
66 {$interfaces COM}
67 {$ENDIF}
68
69 interface
70
71 uses
72 Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
73
74 type
75 { TFBTransaction }
76
77 TFBTransaction = class(TActivityReporter, IActivityMonitor,ITransaction)
78 private
79 function GenerateTPB(sl: array of byte): ITPB;
80 protected
81 FTPB: ITPB;
82 FSeqNo: integer;
83 FDefaultCompletion: TTransactionAction;
84 FAttachments: array of IAttachment; {Keep reference to attachment - ensures
85 attachment cannot be freed before transaction}
86 function GetActivityIntf(att: IAttachment): IActivityMonitor; virtual; abstract;
87 public
88 constructor Create(Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
89 constructor Create(Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
90 constructor Create(Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
91 constructor Create(Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
92 destructor Destroy; override;
93 procedure DoDefaultTransactionEnd(Force: boolean);
94
95 public
96 {ITransaction}
97 function getTPB: ITPB;
98 procedure PrepareForCommit;virtual; abstract;
99 procedure Commit(Force: boolean=false); virtual; abstract;
100 procedure CommitRetaining; virtual; abstract;
101 function GetInTransaction: boolean; virtual; abstract;
102 function GetAttachmentCount: integer;
103 function GetAttachment(index: integer): IAttachment;
104 procedure Rollback(Force: boolean=false); virtual; abstract;
105 procedure RollbackRetaining; virtual; abstract;
106 procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; virtual; abstract;
107 procedure Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit); overload;
108
109 property InTransaction: boolean read GetInTransaction;
110 property TransactionSeqNo: integer read FSeqNo;
111 end;
112
113 implementation
114
115 uses FBMessages, FBStatement;
116
117 { TFBTransaction }
118
119 function TFBTransaction.GenerateTPB(sl: array of byte): ITPB;
120 var
121 i: Integer;
122 begin
123 Result := TTPB.Create;
124 for i := 0 to Length(sl) - 1 do
125 Result.Add(sl[i]);
126 end;
127
128 constructor TFBTransaction.Create(Attachments: array of IAttachment;
129 Params: array of byte; DefaultCompletion: TTransactionAction);
130 begin
131 Create(Attachments,GenerateTPB(Params), DefaultCompletion);
132 end;
133
134 constructor TFBTransaction.Create(Attachments: array of IAttachment; TPB: ITPB;
135 DefaultCompletion: TTransactionAction);
136 var
137 i: Integer;
138 begin
139 inherited Create(nil);
140 if Length(Attachments) = 0 then
141 IBError(ibxeEmptyAttachmentsList,[nil]);
142
143 SetLength(FAttachments,Length(Attachments));
144 for i := 0 to Length(Attachments) - 1 do
145 begin
146 AddMonitor(GetActivityIntf(Attachments[i]));
147 FAttachments[i] := Attachments[i];
148 end;
149 FTPB := TPB;
150 Start(DefaultCompletion);
151 end;
152
153 constructor TFBTransaction.Create(Attachment: IAttachment;
154 Params: array of byte; DefaultCompletion: TTransactionAction);
155 begin
156 Create(Attachment,GenerateTPB(Params),DefaultCompletion);
157 end;
158
159 constructor TFBTransaction.Create(Attachment: IAttachment; TPB: ITPB;
160 DefaultCompletion: TTransactionAction);
161 begin
162 inherited Create(nil);
163 AddMonitor(GetActivityIntf(Attachment));
164 SetLength(FAttachments,1);
165 FAttachments[0] := Attachment;
166 FTPB := TPB;
167 Start(DefaultCompletion);
168 end;
169
170 destructor TFBTransaction.Destroy;
171 begin
172 DoDefaultTransactionEnd(false);
173 inherited Destroy;
174 end;
175
176 procedure TFBTransaction.DoDefaultTransactionEnd(Force: boolean);
177 var i: integer;
178 intf: TInterfacedObject;
179 begin
180 if InTransaction then
181 begin
182 for i := 0 to InterfaceCount - 1 do
183 begin
184 intf := GetInterface(i);
185 if (intf <> nil) and (intf is TFBStatement) then
186 TFBStatement(intf).TransactionEnding(self,Force);
187 end;
188 case FDefaultCompletion of
189 taRollback:
190 Rollback(Force);
191 taCommit:
192 Commit(Force);
193 end;
194 end;
195 end;
196
197 function TFBTransaction.getTPB: ITPB;
198 begin
199 Result := FTPB;
200 end;
201
202 function TFBTransaction.GetAttachmentCount: integer;
203 begin
204 Result := Length(FAttachments);
205 end;
206
207 function TFBTransaction.GetAttachment(index: integer): IAttachment;
208 begin
209 if (index >= 0) and (index < Length(FAttachments)) then
210 Result := FAttachments[index]
211 else
212 IBError(ibxeAttachmentListIndexError,[index]);
213 end;
214
215 procedure TFBTransaction.Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion
216 );
217 begin
218 FTPB := TPB;
219 Start(DefaultCompletion);
220 end;
221
222 end.
223