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: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 5435 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# User Rev Content
1 tony 45 (*
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 tony 56 {$IFDEF MSWINDOWS}
29     {$DEFINE WINDOWS}
30     {$ENDIF}
31 tony 45
32     {$IFDEF FPC}
33 tony 56 {$mode delphi}
34 tony 45 {$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 tony 263 FFirebird30ClientAPI: TFB30ClientAPI;
51 tony 45 procedure StartMultiple;
52     procedure FreeHandle;
53     protected
54     function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
55 tony 263 procedure SetInterface(api: TFBClientAPI); override;
56 tony 45 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 tony 263 with FFirebird30ClientAPI do
82 tony 45 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 tony 315 att.QueryInterface(IActivityMonitor,Result);
111 tony 45 end;
112    
113 tony 263 procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
114     begin
115     inherited SetInterface(api);
116     FFirebird30ClientAPI := api as TFB30ClientAPI;
117     end;
118    
119 tony 45 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 tony 263 with FFirebird30ClientAPI do
137 tony 45 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 tony 263 with FFirebird30ClientAPI do
149 tony 45 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 tony 263 with FFirebird30ClientAPI do
163 tony 45 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 tony 63 if Length(FAttachments) = 1 then
177 tony 263 with FFirebird30ClientAPI do
178 tony 45 begin
179     FTransactionIntf := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
180     (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
181     Check4DataBaseError;
182 tony 63 end
183     else
184     StartMultiple;
185 tony 45 SignalActivity;
186     Inc(FSeqNo);
187     end;
188    
189     procedure TFB30Transaction.Rollback(Force: boolean);
190     begin
191     if FTransactionIntf = nil then
192     Exit;
193 tony 263 with FFirebird30ClientAPI do
194 tony 45 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 tony 263 with FFirebird30ClientAPI do
208 tony 45 begin
209     FTransactionIntf.rollbackRetaining(StatusIntf);
210     Check4DataBaseError;
211     end;
212     SignalActivity;
213     end;
214    
215    
216     end.
217