ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/2.5/FB25Transaction.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: 7859 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. 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 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$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 FFirebird25ClientAPI: TFB25ClientAPI;
86 protected
87 function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
88 function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; override;
89 procedure SetInterface(api: TFBClientAPI); override;
90 procedure InternalStartSingle(attachment: IAttachment); override;
91 procedure InternalStartMultiple; override;
92 procedure InternalCommit(Force: boolean); override;
93 procedure InternalRollback(Force: boolean); override;
94 procedure InternalCommitRetaining; override;
95 procedure InternalRollbackRetaining; override;
96 public
97 property Handle: TISC_TR_HANDLE read FHandle;
98
99 public
100 {ITransaction}
101 function GetInTransaction: boolean; override;
102 procedure PrepareForCommit; override;
103 end;
104
105 implementation
106
107 uses FBMessages, FBParamBlock;
108
109 { TFB25Transaction }
110
111 function TFB25Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
112 begin
113 Result := (att as TFB25Attachment);
114 end;
115
116 function TFB25Transaction.GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer
117 ): ITrInformation;
118 begin
119 Result := TTrInformation.Create(FFirebird25ClientAPI);
120 with FFirebird25ClientAPI, Result as TTrInformation do
121 if isc_transaction_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
122 getBufSize, Buffer) > 0 then
123 IBDataBaseError;
124 end;
125
126 procedure TFB25Transaction.SetInterface(api: TFBClientAPI);
127 begin
128 inherited SetInterface(api);
129 FFirebird25ClientAPI := api as TFB25ClientAPI;
130 OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
131 end;
132
133 procedure TFB25Transaction.InternalStartSingle(attachment: IAttachment);
134 var db_handle: TISC_DB_HANDLE;
135 begin
136 with FFirebird25ClientAPI do
137 try
138 db_handle := (attachment as TFB25Attachment).Handle;
139 Call(isc_start_transaction(StatusVector, @FHandle,1,
140 @db_handle,(FTPB as TTPB).getDataLength,(FTPB as TTPB).getBuffer));
141 except
142 FHandle := nil;
143 raise;
144 end
145 end;
146
147 procedure TFB25Transaction.InternalStartMultiple;
148 var pteb: PISC_TEB_ARRAY;
149 i: integer;
150 begin
151 pteb := nil;
152 with FFirebird25ClientAPI do
153 begin
154 IBAlloc(pteb, 0, Length(FAttachments) * SizeOf(TISC_TEB));
155 try
156 for i := 0 to Length(FAttachments) - 1 do
157 if (FAttachments[i] <> nil) then
158 begin
159 pteb^[i].db_handle := @((FAttachments[i] as TFB25Attachment).Handle);
160 pteb^[i].tpb_length := (FTPB as TTPB).getDataLength;
161 pteb^[i].tpb_address := (FTPB as TTPB).getBuffer;
162 end;
163
164 try
165 Call(isc_start_multiple(StatusVector, @FHandle,
166 Length(FAttachments), PISC_TEB(pteb)));
167 except
168 FHandle := nil;
169 raise;
170 end;
171 finally
172 FreeMem(pteb);
173 end;
174 end;
175 end;
176
177 procedure TFB25Transaction.InternalCommit(Force: boolean);
178 begin
179 with FFirebird25ClientAPI do
180 Call(isc_commit_transaction(StatusVector, @FHandle),not Force);
181 FHandle := nil;
182 end;
183
184 procedure TFB25Transaction.InternalRollback(Force: boolean);
185 begin
186 with FFirebird25ClientAPI do
187 Call(isc_rollback_transaction(StatusVector, @FHandle),not Force);
188 FHandle := nil;
189 end;
190
191 procedure TFB25Transaction.InternalCommitRetaining;
192 begin
193 with FFirebird25ClientAPI do
194 Call(isc_commit_retaining(StatusVector, @FHandle));
195 end;
196
197 procedure TFB25Transaction.InternalRollbackRetaining;
198 begin
199 with FFirebird25ClientAPI do
200 Call(isc_rollback_retaining(StatusVector, @FHandle));
201 end;
202
203 function TFB25Transaction.GetInTransaction: boolean;
204 begin
205 Result := FHandle <> nil;
206 end;
207
208 procedure TFB25Transaction.PrepareForCommit;
209 begin
210 if Length(FAttachments) < 2 then
211 IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
212 if FHandle = nil then
213 Exit;
214 with FFirebird25ClientAPI do
215 Call(isc_prepare_transaction(StatusVector, @FHandle));
216 end;
217
218 end.
219

Properties

Name Value
svn:eol-style native