ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBTransaction.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years ago) by tony
Content type: text/x-pascal
File size: 8260 byte(s)
Log Message:
Committing updates for Trunk

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