ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/3.0/FB30Transaction.pas
Revision: 363
Committed: Tue Dec 7 13:30:05 2021 UTC (8 months ago) by tony
File size: 5772 byte(s)
Log Message:
add fbintf
Line File contents
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 destructor Destroy; override;
64 property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
65 {ITransaction}
66 function GetInTransaction: boolean; override;
67 procedure PrepareForCommit; override;
68 end;
69
70
71 implementation
72
73 uses FBMessages;
74
75 { TFB30Transaction }
76
77 procedure TFB30Transaction.FreeHandle(Force: boolean);
78 begin
79 if assigned(FTransactionIntf) then
80 try
81 FTransactionIntf.release;
82 except
83 if not Force then raise;
84 {else ignore if Force = true}
85 end;
86 FTransactionIntf := nil;
87 end;
88
89 function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
90 begin
91 att.QueryInterface(IActivityMonitor,Result);
92 end;
93
94 procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
95 begin
96 inherited SetInterface(api);
97 FFirebird30ClientAPI := api as TFB30ClientAPI;
98 end;
99
100 function TFB30Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
101 ): ITrInformation;
102 begin
103 Result := TTrInformation.Create(FFirebird30ClientAPI);
104 with FFirebird30ClientAPI, Result as TTrInformation do
105 begin
106 FTransactionIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
107 getBufSize, BytePtr(Buffer));
108 Check4DataBaseError;
109 end
110 end;
111
112 procedure TFB30Transaction.InternalStartSingle(attachment: IAttachment);
113 begin
114 with FFirebird30ClientAPI do
115 begin
116 FTransactionIntf := (attachment as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
117 (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
118 Check4DataBaseError;
119 end;
120 SignalActivity;
121 end;
122
123 procedure TFB30Transaction.InternalStartMultiple;
124 var Dtc: IDtc;
125 DtcStart: IDtcStart;
126 i: integer;
127 begin
128 with FFirebird30ClientAPI do
129 begin
130 Dtc := MasterIntf.getDtc;
131 DtcStart := Dtc.startBuilder(StatusIntf);
132 Check4DataBaseError;
133
134 for i := 0 to Length(FAttachments) - 1 do
135 if (FAttachments[i] <> nil) then
136 begin
137 DTCStart.addWithTpb(StatusIntf,
138 (FAttachments[i] as TFB30Attachment).AttachmentIntf,
139 (FTPB as TTPB).getDataLength,
140 BytePtr((FTPB as TTPB).getBuffer));
141 Check4DataBaseError;
142 end;
143
144 FTransactionIntf := DtcStart.start(StatusIntf);
145 Check4DataBaseError;
146 SignalActivity;
147 end;
148 end;
149
150 procedure TFB30Transaction.InternalCommit(Force: boolean);
151 begin
152 with FFirebird30ClientAPI do
153 begin
154 FTransactionIntf.commit(StatusIntf);
155 if not Force and InErrorState then
156 IBDataBaseError;
157 end;
158 SignalActivity;
159 FreeHandle(Force);
160 end;
161
162 procedure TFB30Transaction.InternalCommitRetaining;
163 begin
164 with FFirebird30ClientAPI do
165 begin
166 FTransactionIntf.commitRetaining(StatusIntf);
167 Check4DataBaseError;
168 end;
169 SignalActivity;
170 end;
171
172 procedure TFB30Transaction.InternalRollback(Force: boolean);
173 begin
174 with FFirebird30ClientAPI do
175 begin
176 FTransactionIntf.rollback(StatusIntf);
177 if not Force and InErrorState then
178 IBDataBaseError;
179 end;
180 SignalActivity;
181 FreeHandle(Force);
182 end;
183
184 procedure TFB30Transaction.InternalRollbackRetaining;
185 begin
186 with FFirebird30ClientAPI do
187 begin
188 FTransactionIntf.rollbackRetaining(StatusIntf);
189 Check4DataBaseError;
190 end;
191 SignalActivity;
192 end;
193
194 destructor TFB30Transaction.Destroy;
195 begin
196 inherited Destroy;
197 FreeHandle(true);
198 end;
199
200 function TFB30Transaction.GetInTransaction: boolean;
201 begin
202 Result := FTransactionIntf <> nil;
203 end;
204
205 procedure TFB30Transaction.PrepareForCommit;
206 begin
207 if Length(FAttachments) < 2 then
208 IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
209 if FTransactionIntf = nil then
210 Exit;
211 with FFirebird30ClientAPI do
212 begin
213 FTransactionIntf.prepare(StatusIntf,0,nil);
214 Check4DataBaseError;
215 end;
216 SignalActivity;
217 end;
218
219
220 end.
221