ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/3.0/FB30Transaction.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: 5424 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.
4 *
5 * The contents of this file are subject to the Initial Developer's
6 * Public License Version 1.0 (the "License"); you may not use this
7 * file except in compliance with the License. You may obtain a copy
8 * of the License here:
9 *
10 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11 *
12 * Software distributed under the License is distributed on an "AS
13 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14 * implied. See the License for the specific language governing rights
15 * and limitations under the License.
16 *
17 * The Initial Developer of the Original Code is Tony Whyman.
18 *
19 * The Original Code is (C) 2016 Tony Whyman, MWA Software
20 * (http://www.mwasoftware.co.uk).
21 *
22 * All Rights Reserved.
23 *
24 * Contributor(s): ______________________________________.
25 *
26 *)
27 unit FB30Transaction;
28 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$interfaces COM}
35 {$ENDIF}
36
37 interface
38
39 uses
40 Classes, SysUtils, Firebird, IB, FBClientAPI, FB30ClientAPI,
41 FB30Attachment, FBParamBlock, FBActivityMonitor, FBTransaction;
42
43 type
44
45 { TFB30Transaction }
46
47 TFB30Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
48 private
49 FTransactionIntf: Firebird.ITransaction;
50 FFirebird30ClientAPI: TFB30ClientAPI;
51 procedure StartMultiple;
52 procedure FreeHandle;
53 protected
54 function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
55 procedure SetInterface(api: TFBClientAPI); override;
56 public
57 destructor Destroy; override;
58 property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
59 {ITransaction}
60 function GetInTransaction: boolean; override;
61 procedure PrepareForCommit; override;
62 procedure Commit(Force: boolean=false); override;
63 procedure CommitRetaining; override;
64 procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
65 procedure Rollback(Force: boolean=false); override;
66 procedure RollbackRetaining; override;
67 end;
68
69
70 implementation
71
72 uses FBMessages;
73
74 { TFB30Transaction }
75
76 procedure TFB30Transaction.StartMultiple;
77 var Dtc: IDtc;
78 DtcStart: IDtcStart;
79 i: integer;
80 begin
81 with FFirebird30ClientAPI do
82 begin
83 Dtc := MasterIntf.getDtc;
84 DtcStart := Dtc.startBuilder(StatusIntf);
85 Check4DataBaseError;
86
87 for i := 0 to Length(FAttachments) - 1 do
88 if (FAttachments[i] <> nil) then
89 begin
90 DTCStart.addWithTpb(StatusIntf,
91 (FAttachments[i] as TFB30Attachment).AttachmentIntf,
92 (FTPB as TTPB).getDataLength,
93 BytePtr((FTPB as TTPB).getBuffer));
94 Check4DataBaseError;
95 end;
96 FTransactionIntf := DtcStart.start(StatusIntf);
97 Check4DataBaseError;
98 end;
99 end;
100
101 procedure TFB30Transaction.FreeHandle;
102 begin
103 if assigned(FTransactionIntf) then
104 FTransactionIntf.release;
105 FTransactionIntf := nil;
106 end;
107
108 function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
109 begin
110 Result := att as TFB30Attachment;
111 end;
112
113 procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
114 begin
115 inherited SetInterface(api);
116 FFirebird30ClientAPI := api as TFB30ClientAPI;
117 end;
118
119 destructor TFB30Transaction.Destroy;
120 begin
121 inherited Destroy;
122 FreeHandle;
123 end;
124
125 function TFB30Transaction.GetInTransaction: boolean;
126 begin
127 Result := FTransactionIntf <> nil;
128 end;
129
130 procedure TFB30Transaction.PrepareForCommit;
131 begin
132 if Length(FAttachments) < 2 then
133 IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
134 if FTransactionIntf = nil then
135 Exit;
136 with FFirebird30ClientAPI do
137 begin
138 FTransactionIntf.prepare(StatusIntf,0,nil);
139 Check4DataBaseError;
140 end;
141 SignalActivity;
142 end;
143
144 procedure TFB30Transaction.Commit(Force: boolean);
145 begin
146 if FTransactionIntf = nil then
147 Exit;
148 with FFirebird30ClientAPI do
149 begin
150 FTransactionIntf.commit(StatusIntf);
151 if not Force and InErrorState then
152 IBDataBaseError;
153 end;
154 SignalActivity;
155 FreeHandle;
156 end;
157
158 procedure TFB30Transaction.CommitRetaining;
159 begin
160 if FTransactionIntf = nil then
161 Exit;
162 with FFirebird30ClientAPI do
163 begin
164 FTransactionIntf.commitRetaining(StatusIntf);
165 Check4DataBaseError;
166 end;
167 SignalActivity;
168 end;
169
170 procedure TFB30Transaction.Start(DefaultCompletion: TTransactionCompletion);
171 begin
172 if FTransactionIntf <> nil then
173 Exit;
174 FDefaultCompletion := DefaultCompletion;
175
176 if Length(FAttachments) = 1 then
177 with FFirebird30ClientAPI do
178 begin
179 FTransactionIntf := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
180 (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
181 Check4DataBaseError;
182 end
183 else
184 StartMultiple;
185 SignalActivity;
186 Inc(FSeqNo);
187 end;
188
189 procedure TFB30Transaction.Rollback(Force: boolean);
190 begin
191 if FTransactionIntf = nil then
192 Exit;
193 with FFirebird30ClientAPI do
194 begin
195 FTransactionIntf.rollback(StatusIntf);
196 if not Force and InErrorState then
197 IBDataBaseError;
198 end;
199 SignalActivity;
200 FreeHandle;
201 end;
202
203 procedure TFB30Transaction.RollbackRetaining;
204 begin
205 if FTransactionIntf = nil then
206 Exit;
207 with FFirebird30ClientAPI do
208 begin
209 FTransactionIntf.rollbackRetaining(StatusIntf);
210 Check4DataBaseError;
211 end;
212 SignalActivity;
213 end;
214
215
216 end.
217