ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/client/FBTransaction.pas

Comparing ibx/trunk/fbintf/client/FBTransaction.pas (file contents):
Revision 315 by tony, Thu Feb 25 11:56:36 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 138 | Line 144 | type
144		function LookupItemType(ParamTypeName: AnsiString): byte; override;
145		public
146		constructor Create(api: TFBClientAPI);
147	+	function GetParamTypeName(ParamType: byte): Ansistring;
148	+	{$IFDEF FPC}
149	+	function ITPB.GetDPBParamTypeName = GetParamTypeName;
150	+	{$ELSE}
151		function GetDPBParamTypeName(ParamType: byte): Ansistring;
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
#	Line 185 | 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 272 | 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 292 | 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 309 | Line 399 | begin
399		FBuffer^ := isc_tpb_version3;
400		end;
401
402	<	function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
402	>	function TTPB.GetParamTypeName(ParamType: byte): Ansistring;
403		begin
404		if ParamType <= isc_tpb_last_tpb_constant then
405		Result := TPBConstantNames[ParamType]
#	Line 317 | Line 407 | begin
407		Result := '';
408		end;
409
410	+	{$IFNDEF FPC}
411	+	function TTPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
412	+	begin
413	+	Result := GetParamTypeName(ParamType);
414	+	end;
415	+	{$ENDIF}
416	+
417	+
418		function TTPB.LookupItemType(ParamTypeName: AnsiString): byte;
419		var i: byte;
420		begin
#	Line 333 | 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