ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/FBTransaction.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBTransaction.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC

# Line 60 | Line 60
60   {                                                                        }
61   {************************************************************************}
62   unit FBTransaction;
63 + {$IFDEF MSWINDOWS}
64 + {$DEFINE WINDOWS}
65 + {$ENDIF}
66  
67   {$IFDEF FPC}
68 < {$mode objfpc}{$H+}
68 > {$mode delphi}
69   {$interfaces COM}
70   {$ENDIF}
71  
72   interface
73  
74   uses
75 <  Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
75 >  Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
76  
77   type
78    { TFBTransaction }
79  
80    TFBTransaction = class(TActivityReporter, IActivityMonitor,ITransaction)
81    private
82 +    FFirebirdAPI: TFBClientAPI;
83      function GenerateTPB(sl: array of byte): ITPB;
84    protected
85      FTPB: ITPB;
# Line 84 | Line 88 | type
88      FAttachments: array of IAttachment; {Keep reference to attachment - ensures
89                                            attachment cannot be freed before transaction}
90      function GetActivityIntf(att: IAttachment): IActivityMonitor; virtual; abstract;
91 +    procedure SetInterface(api: TFBClientAPI); virtual;
92    public
93 <    constructor Create(Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
94 <    constructor Create(Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
95 <    constructor Create(Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
96 <    constructor Create(Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
93 >    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
94 >    constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
95 >    constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
96 >    constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
97      destructor Destroy; override;
98      procedure DoDefaultTransactionEnd(Force: boolean);
99 +    property FirebirdAPI: TFBClientAPI read FFirebirdAPI;
100  
101    public
102      {ITransaction}
# Line 110 | Line 116 | type
116      property TransactionSeqNo: integer read FSeqNo;
117    end;
118  
119 +  {The transaction user interface is used to force an action on the end of the
120 +   transaction.}
121 +
122 +  ITransactionUser = interface
123 +    ['{156fcdc9-a326-44b3-a82d-f23c6fb9f97c}']
124 +    procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
125 +  end;
126 +
127 +  { TTPBItem }
128 +
129 +  TTPBItem = class(TParamBlockItem,ITPBItem)
130 +  public
131 +    function getParamTypeName: AnsiString; override;
132 +  end;
133 +
134 +  { TTPB }
135 +
136 +  TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
137 +  protected
138 +    function LookupItemType(ParamTypeName: AnsiString): byte; override;
139 +  public
140 +    constructor Create(api: TFBClientAPI);
141 +    function GetParamTypeName(ParamType: byte): Ansistring;
142 +    {$IFDEF FPC}
143 +    function ITPB.GetDPBParamTypeName = GetParamTypeName;
144 +    {$ELSE}
145 +    function GetDPBParamTypeName(ParamType: byte): Ansistring;
146 +    {$ENDIF}
147 + end;
148 +
149   implementation
150  
151 < uses FBMessages, FBStatement;
151 > uses FBMessages;
152 >
153 > const
154 >  isc_tpb_last_tpb_constant = isc_tpb_at_snapshot_number;
155 >
156 >  TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
157 >    'consistency',
158 >    'concurrency',
159 >    'shared',
160 >    'protected',
161 >    'exclusive',
162 >    'wait',
163 >    'nowait',
164 >    'read',
165 >    'write',
166 >    'lock_read',
167 >    'lock_write',
168 >    'verb_time',
169 >    'commit_time',
170 >    'ignore_limbo',
171 >    'read_committed',
172 >    'autocommit',
173 >    'rec_version',
174 >    'no_rec_version',
175 >    'restart_requests',
176 >    'no_auto_undo',
177 >    'lock_timeout',
178 >    'read_consistency',
179 >    'at_snapshot_number'
180 >  );
181  
182   { TFBTransaction }
183  
# Line 120 | Line 185 | function TFBTransaction.GenerateTPB(sl:
185   var
186    i: Integer;
187   begin
188 <  Result := TTPB.Create;
188 >  Result := TTPB.Create(FFirebirdAPI);
189    for i := 0 to Length(sl) - 1 do
190      Result.Add(sl[i]);
191   end;
192  
193 < constructor TFBTransaction.Create(Attachments: array of IAttachment;
193 > procedure TFBTransaction.SetInterface(api: TFBClientAPI);
194 > begin
195 >  FFirebirdAPI := api;
196 > end;
197 >
198 > constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment;
199    Params: array of byte; DefaultCompletion: TTransactionAction);
200   begin
201 <  Create(Attachments,GenerateTPB(Params), DefaultCompletion);
201 >  Create(api, Attachments,GenerateTPB(Params), DefaultCompletion);
202   end;
203  
204 < constructor TFBTransaction.Create(Attachments: array of IAttachment; TPB: ITPB;
204 > constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB;
205    DefaultCompletion: TTransactionAction);
206   var
207    i: Integer;
208   begin
209    inherited Create(nil);
210 +  SetInterface(api);
211    if Length(Attachments) = 0 then
212      IBError(ibxeEmptyAttachmentsList,[nil]);
213  
214 +  {make sure all attachments use same Firebird API}
215 +  for i := 0 to Length(Attachments) - 1 do
216 +    if Attachments[i].getFirebirdAPI.GetFBLibrary.GetHandle <> FFirebirdAPI.GetFBLibrary.GetHandle then
217 +      IBError(ibxeDifferentAPIs,[nil]);
218 +
219    SetLength(FAttachments,Length(Attachments));
220    for i := 0 to Length(Attachments) - 1 do
221    begin
# Line 150 | Line 226 | begin
226    Start(DefaultCompletion);
227   end;
228  
229 < constructor TFBTransaction.Create(Attachment: IAttachment;
229 > constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment;
230    Params: array of byte; DefaultCompletion: TTransactionAction);
231   begin
232 <  Create(Attachment,GenerateTPB(Params),DefaultCompletion);
232 >  Create(api,Attachment,GenerateTPB(Params),DefaultCompletion);
233   end;
234  
235 < constructor TFBTransaction.Create(Attachment: IAttachment; TPB: ITPB;
235 > constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB;
236    DefaultCompletion: TTransactionAction);
237   begin
238    inherited Create(nil);
239 +  SetInterface(api);
240    AddMonitor(GetActivityIntf(Attachment));
241    SetLength(FAttachments,1);
242    FAttachments[0] := Attachment;
# Line 175 | Line 252 | end;
252  
253   procedure TFBTransaction.DoDefaultTransactionEnd(Force: boolean);
254   var i: integer;
255 <    intf: TInterfacedObject;
255 >    intf: IUnknown;
256 >    user: ITransactionUser;
257   begin
258    if InTransaction then
259    begin
260      for i := 0 to InterfaceCount - 1 do
261      begin
262        intf := GetInterface(i);
263 <      if (intf <> nil) and  (intf is TFBStatement) then
264 <        TFBStatement(intf).TransactionEnding(self,Force);
263 >      if (intf <> nil) and  (intf.QueryInterface(ITransactionUser,user) = S_OK) then
264 >        user.TransactionEnding(self,Force);
265      end;
266      case FDefaultCompletion of
267      taRollback:
# Line 219 | Line 297 | begin
297    Start(DefaultCompletion);
298   end;
299  
300 + { TTPBItem }
301 +
302 + function TTPBItem.getParamTypeName: AnsiString;
303 + begin
304 +  Result :=  TPBPrefix + TPBConstantNames[getParamType];
305 + end;
306 +
307 +
308 + {TTPB}
309 +
310 + constructor TTPB.Create(api: TFBClientAPI);
311 + begin
312 +  inherited Create(api);
313 +  FDataLength := 1;
314 +  FBuffer^ := isc_tpb_version3;
315 + end;
316 +
317 + function TTPB.GetParamTypeName(ParamType: byte): Ansistring;
318 + begin
319 +  if ParamType <= isc_tpb_last_tpb_constant then
320 +    Result := TPBConstantNames[ParamType]
321 +  else
322 +    Result := '';
323 + end;
324 +
325 + {$IFNDEF FPC}
326 + function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
327 + begin
328 +  Result := GetParamTypeName(ParamType);
329 + end;
330 + {$ENDIF}
331 +
332 +
333 + function TTPB.LookupItemType(ParamTypeName: AnsiString): byte;
334 + var i: byte;
335 + begin
336 +  Result := 0;
337 +  ParamTypeName := LowerCase(ParamTypeName);
338 +  if (Pos(TPBPrefix, ParamTypeName) = 1) then
339 +    Delete(ParamTypeName, 1, Length(TPBPrefix));
340 +
341 +  for i := 1 to isc_tpb_last_tpb_constant do
342 +    if (ParamTypeName = TPBConstantNames[i]) then
343 +    begin
344 +      Result := i;
345 +      break;
346 +    end;
347 + end;
348 +
349   end.
350  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines