ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/2.5/FB25Transaction.pas
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Transaction.pas
File size: 7500 byte(s)
Log Message:
Release 2.3.2 committed

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. 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 FB25Transaction;
63 tony 56 {$IFDEF MSWINDOWS}
64     {$DEFINE WINDOWS}
65     {$ENDIF}
66 tony 45
67     {$IFDEF FPC}
68 tony 56 {$mode delphi}
69 tony 45 {$interfaces COM}
70     {$ENDIF}
71     {$R-}
72    
73     interface
74    
75     uses
76     Classes, SysUtils, IB, FBClientAPI, FB25ClientAPI, IBHeader,
77     FB25Attachment, FBActivityMonitor, FBTransaction;
78    
79     type
80     { TFB25Transaction }
81    
82     TFB25Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
83     private
84     FHandle: TISC_TR_HANDLE;
85 tony 263 FFirebird25ClientAPI: TFB25ClientAPI;
86 tony 45 protected
87     function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
88 tony 263 procedure SetInterface(api: TFBClientAPI); override;
89 tony 45 public
90     property Handle: TISC_TR_HANDLE read FHandle;
91    
92     public
93     {ITransaction}
94     function GetInTransaction: boolean; override;
95     procedure PrepareForCommit; override;
96     procedure Commit(Force: boolean=false); override;
97     procedure CommitRetaining; override;
98     procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
99     procedure Rollback(Force: boolean=false); override;
100     procedure RollbackRetaining; override;
101     end;
102    
103     implementation
104    
105     uses FBMessages, FBParamBlock;
106    
107     { TFB25Transaction }
108    
109     function TFB25Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
110     begin
111     Result := (att as TFB25Attachment);
112     end;
113    
114 tony 263 procedure TFB25Transaction.SetInterface(api: TFBClientAPI);
115     begin
116     inherited SetInterface(api);
117     FFirebird25ClientAPI := api as TFB25ClientAPI;
118     OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
119     end;
120    
121 tony 45 function TFB25Transaction.GetInTransaction: boolean;
122     begin
123     Result := FHandle <> nil;
124     end;
125    
126     procedure TFB25Transaction.PrepareForCommit;
127     begin
128     if Length(FAttachments) < 2 then
129     IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
130     if FHandle = nil then
131     Exit;
132 tony 263 with FFirebird25ClientAPI do
133 tony 45 Call(isc_prepare_transaction(StatusVector, @FHandle));
134     end;
135    
136     procedure TFB25Transaction.Commit(Force: boolean);
137     begin
138     if FHandle = nil then
139     Exit;
140 tony 263 with FFirebird25ClientAPI do
141 tony 45 Call(isc_commit_transaction(StatusVector, @FHandle),not Force);
142     FHandle := nil;
143     end;
144    
145     procedure TFB25Transaction.CommitRetaining;
146     begin
147     if FHandle = nil then
148     Exit;
149 tony 263 with FFirebird25ClientAPI do
150 tony 45 Call(isc_commit_retaining(StatusVector, @FHandle));
151     end;
152    
153     procedure TFB25Transaction.Start(DefaultCompletion: TTransactionCompletion);
154     var pteb: PISC_TEB_ARRAY;
155     i: integer;
156     db_handle: TISC_DB_HANDLE;
157     begin
158     if FHandle <> nil then
159     Exit;
160     pteb := nil;
161     FDefaultCompletion := DefaultCompletion;
162 tony 263 with FFirebird25ClientAPI do
163 tony 45 if (Length(FAttachments) = 1) then
164     try
165     db_handle := (FAttachments[0] as TFB25Attachment).Handle;
166     Call(isc_start_transaction(StatusVector, @FHandle,1,
167     @db_handle,(FTPB as TTPB).getDataLength,(FTPB as TTPB).getBuffer));
168     except
169     FHandle := nil;
170     raise;
171     end
172     else
173     begin
174     IBAlloc(pteb, 0, Length(FAttachments) * SizeOf(TISC_TEB));
175     try
176     for i := 0 to Length(FAttachments) - 1 do
177     if (FAttachments[i] <> nil) then
178     begin
179     pteb^[i].db_handle := @((FAttachments[i] as TFB25Attachment).Handle);
180     pteb^[i].tpb_length := (FTPB as TTPB).getDataLength;
181     pteb^[i].tpb_address := (FTPB as TTPB).getBuffer;
182     end;
183     try
184     Call(isc_start_multiple(StatusVector, @FHandle,
185     Length(FAttachments), PISC_TEB(pteb)));
186     except
187     FHandle := nil;
188     raise;
189     end;
190     finally
191     FreeMem(pteb);
192     end;
193     end;
194     Inc(FSeqNo);
195     end;
196    
197     procedure TFB25Transaction.Rollback(Force: boolean);
198     begin
199     if FHandle = nil then
200     Exit;
201 tony 263 with FFirebird25ClientAPI do
202 tony 45 Call(isc_rollback_transaction(StatusVector, @FHandle),not Force);
203     FHandle := nil;
204     end;
205    
206     procedure TFB25Transaction.RollbackRetaining;
207     begin
208     if FHandle = nil then
209     Exit;
210 tony 263 with FFirebird25ClientAPI do
211 tony 45 Call(isc_rollback_retaining(StatusVector, @FHandle));
212     end;
213    
214     end.
215