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: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25Transaction.pas
File size: 7141 byte(s)
Log Message:
Committing updates for Release R2-0-0

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