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

Comparing ibx/trunk/fbintf/client/FBTransaction.pas (file contents):
Revision 358 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 2021 UTC

# Line 72 | Line 72 | unit FBTransaction;
72   interface
73  
74   uses
75 <  Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
75 >  Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI, FBOutputBlock;
76  
77   type
78    { TFBTransaction }
# Line 87 | Line 87 | type
87      FDefaultCompletion: TTransactionAction;
88      FAttachments: array of IAttachment; {Keep reference to attachment - ensures
89                                            attachment cannot be freed before transaction}
90 +    procedure CheckHandle;
91      function GetActivityIntf(att: IAttachment): IActivityMonitor; virtual; abstract;
92      procedure SetInterface(api: TFBClientAPI); virtual;
93 +    function GetTrInfo(ReqBuffer: PByte; ReqBufLen: integer): ITrInformation; virtual; abstract;
94    public
95      constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
96      constructor Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
# Line 105 | Line 107 | type
107      procedure Commit(Force: boolean=false);  virtual; abstract;
108      procedure CommitRetaining;  virtual; abstract;
109      function GetInTransaction: boolean; virtual; abstract;
110 +    function GetIsReadOnly: boolean;
111 +    function GetTransactionID: integer;
112      function GetAttachmentCount: integer;
113      function GetAttachment(index: integer): IAttachment;
114      procedure Rollback(Force: boolean=false);  virtual; abstract;
115      procedure RollbackRetaining;  virtual; abstract;
116      procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; virtual; abstract;
117      procedure Start(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit); overload;
118 +    function GetTrInformation(Requests: array of byte): ITrInformation; overload;
119 +    function GetTrInformation(Request: byte): ITrInformation; overload;
120  
121      property InTransaction: boolean read GetInTransaction;
122      property TransactionSeqNo: integer read FSeqNo;
# Line 146 | Line 152 | type
152      {$ENDIF}
153   end;
154  
155 +  {$IFDEF FPC}
156 +  TTrInfoItem = class;
157 +
158 +  { TTrInfoItem }
159 +
160 +  TTrInfoItem = class(TOutputBlockItemGroup<TTrInfoItem,ITrInfoItem>,ITrInfoItem)
161 +  {$ELSE}
162 +    TTransInfoItem = class(TOutputBlockItemGroup<TOutputBlockItem,ITransInfoItem>,ITransInfoItem)
163 +  {$ENDIF}
164 +    public
165 +      procedure DecodeTraIsolation(var IsolationType, RecVersion: byte);
166 +  end;
167 +
168 +  { TTrInformation }
169 +
170 +  TTrInformation = class(TCustomOutputBlock<TTrInfoItem,ITrInfoItem>, ITrInformation)
171 +  protected
172 +    procedure DoParseBuffer; override;
173 +  public
174 +    constructor Create(api: TFBClientAPI; aSize: integer = DefaultBufferSize);
175 +    {$IFNDEF FPC}
176 +    function Find(ItemType: byte): ITransInfoItem;
177 +    {$ENDIF}
178 +  end;
179 +
180   implementation
181  
182   uses FBMessages;
# Line 190 | Line 221 | begin
221      Result.Add(sl[i]);
222   end;
223  
224 + procedure TFBTransaction.CheckHandle;
225 + begin
226 +  if not InTransaction then
227 +    IBError(ibxeNotInTransaction,[]);
228 + end;
229 +
230   procedure TFBTransaction.SetInterface(api: TFBClientAPI);
231   begin
232    FFirebirdAPI := api;
# Line 277 | Line 314 | begin
314    Result := FTPB;
315   end;
316  
317 + function TFBTransaction.GetIsReadOnly: boolean;
318 + var Info: ITrInformation;
319 + begin
320 +  Info := GetTrInformation(isc_info_tra_access);
321 +  if (Info.Count > 0) and (Info[0].getItemType = isc_info_tra_access) then
322 +    Result := Info[0].getAsInteger = isc_info_tra_readonly
323 +  else
324 +    Result := false;
325 + end;
326 +
327 + function TFBTransaction.GetTransactionID: integer;
328 + var Info: ITrInformation;
329 + begin
330 +  Result := -1;
331 +  Info := GetTrInformation(isc_info_tra_id);
332 +  if (Info.Count > 0) and (Info[0].getItemType = isc_info_tra_id) then
333 +    Result := Info[0].getAsInteger;
334 + end;
335 +
336   function TFBTransaction.GetAttachmentCount: integer;
337   begin
338    Result := Length(FAttachments);
# Line 297 | Line 353 | begin
353    Start(DefaultCompletion);
354   end;
355  
356 + function TFBTransaction.GetTrInformation(Requests: array of byte
357 +  ): ITrInformation;
358 + var ReqBuffer: PByte;
359 +    i: integer;
360 + begin
361 +  CheckHandle;
362 +  if Length(Requests) = 1 then
363 +    Result := GetTrInformation(Requests[0])
364 +  else
365 +  begin
366 +    GetMem(ReqBuffer,Length(Requests));
367 +    try
368 +      for i := 0 to Length(Requests) - 1 do
369 +        ReqBuffer[i] := Requests[i];
370 +
371 +      Result := GetTrInfo(ReqBuffer,Length(Requests));
372 +
373 +    finally
374 +      FreeMem(ReqBuffer);
375 +    end;
376 +  end;
377 + end;
378 +
379 + function TFBTransaction.GetTrInformation(Request: byte): ITrInformation;
380 + begin
381 +  CheckHandle;
382 +  Result := GetTrInfo(@Request,1);
383 + end;
384 +
385   { TTPBItem }
386  
387   function TTPBItem.getParamTypeName: AnsiString;
# Line 346 | Line 431 | begin
431      end;
432   end;
433  
434 + { TTrInfoItem }
435 +
436 + procedure TTrInfoItem.DecodeTraIsolation(var IsolationType, RecVersion: byte);
437 + begin
438 +  with FFirebirdClientAPI, ItemData^ do
439 +  if getItemType = isc_info_tra_isolation then
440 +  begin
441 +    if FDataLength = 1 then
442 +    begin
443 +      IsolationType := getAsInteger;
444 +      RecVersion := 0;
445 +    end
446 +    else
447 +    begin
448 +      IsolationType := (FBufPtr + 3)^;
449 +      RecVersion := (FBufPtr + 4)^;
450 +    end
451 +  end
452 +  else
453 +    IBError(ibxeInfoBufferTypeError,[integer(FBufPtr^)]);
454 + end;
455 +
456 + { TTrInformation }
457 +
458 + procedure TTrInformation.DoParseBuffer;
459 + var P: PByte;
460 +    index: integer;
461 + begin
462 +  P := Buffer;
463 +  index := 0;
464 +  SetLength(FItems,0);
465 +  while (P^ <> isc_info_end) and (P < Buffer + getBufSize) do
466 +  begin
467 +    SetLength(FItems,index+1);
468 +    case byte(P^) of
469 +    isc_info_tra_id,
470 +    isc_info_tra_oldest_interesting,
471 +    isc_info_tra_oldest_active,
472 +    isc_info_tra_oldest_snapshot,
473 +    fb_info_tra_snapshot_number,
474 +    isc_info_tra_lock_timeout:
475 +      FItems[index] := AddIntegerItem(P);
476 +
477 +    isc_info_tra_isolation,
478 +      {return transaction isolation mode of current transaction.
479 +        format of returned clumplets is following:
480 +
481 +        isc_info_tra_isolation,
482 +                1, isc_info_tra_consistency | isc_info_tra_concurrency
483 +        |
484 +                2, isc_info_tra_read_committed,
485 +                         isc_info_tra_no_rec_version | isc_info_tra_rec_version
486 +
487 +        i.e. for read committed transactions returned 2 items while for
488 +        other transactions returned 1 item}
489 +
490 +    isc_info_tra_access:
491 +      FItems[index] := AddIntegerItem(P);
492 +    fb_info_tra_dbpath:
493 +      FItems[index] := AddStringItem(P);
494 +    else
495 +      FItems[index] := AddItem(P);
496 +    end;
497 +    P := P + FItems[index]^.FSize;
498 +    Inc(index);
499 +  end;
500 + end;
501 +
502 + constructor TTrInformation.Create(api: TFBClientAPI; aSize: integer);
503 + begin
504 +  inherited Create(api,aSize);
505 +  FIntegerType := dtInteger;
506 + end;
507 +
508   end.
509  

Diff Legend

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