ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/3.0/FB30Transaction.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 6302 byte(s)
Log Message:
set line ending property

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 FreeHandle(Force: boolean);
52 protected
53 function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
54 procedure SetInterface(api: TFBClientAPI); override;
55 function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
56 procedure InternalStartSingle(attachment: IAttachment); override;
57 procedure InternalStartMultiple; override;
58 procedure InternalCommit(Force: boolean); override;
59 procedure InternalCommitRetaining; override;
60 procedure InternalRollback(Force: boolean); override;
61 procedure InternalRollbackRetaining; override;
62 public
63 constructor Create(api: TFBClientAPI; Attachment: IAttachment; aTransactionIntf: Firebird.ITransaction); overload;
64 destructor Destroy; override;
65 property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
66 {ITransaction}
67 function GetInTransaction: boolean; override;
68 procedure PrepareForCommit; override;
69 end;
70
71
72 implementation
73
74 uses FBMessages;
75
76 { TFB30Transaction }
77
78 procedure TFB30Transaction.FreeHandle(Force: boolean);
79 begin
80 if assigned(FTransactionIntf) then
81 try
82 FTransactionIntf.release;
83 except
84 if not Force then raise;
85 {else ignore if Force = true}
86 end;
87 FTransactionIntf := nil;
88 end;
89
90 function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
91 begin
92 att.QueryInterface(IActivityMonitor,Result);
93 end;
94
95 procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
96 begin
97 inherited SetInterface(api);
98 FFirebird30ClientAPI := api as TFB30ClientAPI;
99 end;
100
101 function TFB30Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
102 ): ITrInformation;
103 begin
104 Result := TTrInformation.Create(FFirebird30ClientAPI);
105 with FFirebird30ClientAPI, Result as TTrInformation do
106 begin
107 FTransactionIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
108 getBufSize, BytePtr(Buffer));
109 Check4DataBaseError;
110 end
111 end;
112
113 procedure TFB30Transaction.InternalStartSingle(attachment: IAttachment);
114 begin
115 if FTransactionIntf = nil then
116 with FFirebird30ClientAPI do
117 begin
118 FTransactionIntf := (attachment as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
119 (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
120 Check4DataBaseError;
121 FTransactionIntf.addRef();
122 end;
123 SignalActivity;
124 end;
125
126 procedure TFB30Transaction.InternalStartMultiple;
127 var Dtc: IDtc;
128 DtcStart: IDtcStart;
129 i: integer;
130 begin
131 if FTransactionIntf = nil then
132 with FFirebird30ClientAPI do
133 begin
134 Dtc := MasterIntf.getDtc;
135 DtcStart := Dtc.startBuilder(StatusIntf);
136 Check4DataBaseError;
137
138 for i := 0 to Length(FAttachments) - 1 do
139 if (FAttachments[i] <> nil) then
140 begin
141 DTCStart.addWithTpb(StatusIntf,
142 (FAttachments[i] as TFB30Attachment).AttachmentIntf,
143 (FTPB as TTPB).getDataLength,
144 BytePtr((FTPB as TTPB).getBuffer));
145 Check4DataBaseError;
146 end;
147
148 FTransactionIntf := DtcStart.start(StatusIntf);
149 Check4DataBaseError;
150 FTransactionIntf.addRef();
151 SignalActivity;
152 end;
153 end;
154
155 procedure TFB30Transaction.InternalCommit(Force: boolean);
156 begin
157 with FFirebird30ClientAPI do
158 begin
159 FTransactionIntf.commit(StatusIntf);
160 if not Force and InErrorState then
161 IBDataBaseError;
162 end;
163 SignalActivity;
164 FreeHandle(Force);
165 end;
166
167 procedure TFB30Transaction.InternalCommitRetaining;
168 begin
169 with FFirebird30ClientAPI do
170 begin
171 FTransactionIntf.commitRetaining(StatusIntf);
172 Check4DataBaseError;
173 end;
174 SignalActivity;
175 end;
176
177 procedure TFB30Transaction.InternalRollback(Force: boolean);
178 begin
179 with FFirebird30ClientAPI do
180 begin
181 FTransactionIntf.rollback(StatusIntf);
182 if not Force and InErrorState then
183 IBDataBaseError;
184 end;
185 SignalActivity;
186 FreeHandle(Force);
187 end;
188
189 procedure TFB30Transaction.InternalRollbackRetaining;
190 begin
191 with FFirebird30ClientAPI do
192 begin
193 FTransactionIntf.rollbackRetaining(StatusIntf);
194 Check4DataBaseError;
195 end;
196 SignalActivity;
197 end;
198
199 constructor TFB30Transaction.Create(api: TFBClientAPI; Attachment: IAttachment;
200 aTransactionIntf: Firebird.ITransaction);
201 begin
202 FTransactionIntf := aTransactionIntf;
203 FTransactionIntf.addRef();
204 FForeignHandle := true;
205 inherited Create(api,Attachment,nil,taCommit,'');
206 end;
207
208 destructor TFB30Transaction.Destroy;
209 begin
210 inherited Destroy;
211 FreeHandle(true);
212 end;
213
214 function TFB30Transaction.GetInTransaction: boolean;
215 begin
216 Result := FTransactionIntf <> nil;
217 end;
218
219 procedure TFB30Transaction.PrepareForCommit;
220 begin
221 if Length(FAttachments) < 2 then
222 IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
223 if FTransactionIntf = nil then
224 Exit;
225 with FFirebird30ClientAPI do
226 begin
227 FTransactionIntf.prepare(StatusIntf,0,nil);
228 Check4DataBaseError;
229 end;
230 SignalActivity;
231 end;
232
233
234 end.
235

Properties

Name Value
svn:eol-style native