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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 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, FBOutputBlock;
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 83 | 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(Attachments: array of IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
96	<	constructor Create(Attachments: array of IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
97	<	constructor Create(Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
98	<	constructor Create(Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
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;
97	>	constructor Create(api: TFBClientAPI; Attachment: IAttachment; Params: array of byte; DefaultCompletion: TTransactionAction); overload;
98	>	constructor Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB; DefaultCompletion: TTransactionAction); overload;
99		destructor Destroy; override;
100		procedure DoDefaultTransactionEnd(Force: boolean);
101	+	property FirebirdAPI: TFBClientAPI read FFirebirdAPI;
102
103		public
104		{ITransaction}
#	Line 99 | 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;
123		end;
124
125	+	{The transaction user interface is used to force an action on the end of the
126	+	transaction.}
127	+
128	+	ITransactionUser = interface
129	+	['{156fcdc9-a326-44b3-a82d-f23c6fb9f97c}']
130	+	procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
131	+	end;
132	+
133	+	{ TTPBItem }
134	+
135	+	TTPBItem = class(TParamBlockItem,ITPBItem)
136	+	public
137	+	function getParamTypeName: AnsiString; override;
138	+	end;
139	+
140	+	{ TTPB }
141	+
142	+	TTPB = class (TCustomParamBlock<TTPBItem,ITPBItem>, ITPB)
143	+	protected
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
181
182	<	uses FBMessages, FBStatement;
182	>	uses FBMessages;
183	>
184	>	const
185	>	isc_tpb_last_tpb_constant = isc_tpb_at_snapshot_number;
186	>
187	>	TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
188	>	'consistency',
189	>	'concurrency',
190	>	'shared',
191	>	'protected',
192	>	'exclusive',
193	>	'wait',
194	>	'nowait',
195	>	'read',
196	>	'write',
197	>	'lock_read',
198	>	'lock_write',
199	>	'verb_time',
200	>	'commit_time',
201	>	'ignore_limbo',
202	>	'read_committed',
203	>	'autocommit',
204	>	'rec_version',
205	>	'no_rec_version',
206	>	'restart_requests',
207	>	'no_auto_undo',
208	>	'lock_timeout',
209	>	'read_consistency',
210	>	'at_snapshot_number'
211	>	);
212
213		{ TFBTransaction }
214
#	Line 120 | Line 216 | function TFBTransaction.GenerateTPB(sl:
216		var
217		i: Integer;
218		begin
219	<	Result := TTPB.Create;
219	>	Result := TTPB.Create(FFirebirdAPI);
220		for i := 0 to Length(sl) - 1 do
221		Result.Add(sl[i]);
222		end;
223
224	<	constructor TFBTransaction.Create(Attachments: array of IAttachment;
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;
233	>	end;
234	>
235	>	constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment;
236		Params: array of byte; DefaultCompletion: TTransactionAction);
237		begin
238	<	Create(Attachments,GenerateTPB(Params), DefaultCompletion);
238	>	Create(api, Attachments,GenerateTPB(Params), DefaultCompletion);
239		end;
240
241	<	constructor TFBTransaction.Create(Attachments: array of IAttachment; TPB: ITPB;
241	>	constructor TFBTransaction.Create(api: TFBClientAPI; Attachments: array of IAttachment; TPB: ITPB;
242		DefaultCompletion: TTransactionAction);
243		var
244		i: Integer;
245		begin
246		inherited Create(nil);
247	+	SetInterface(api);
248		if Length(Attachments) = 0 then
249		IBError(ibxeEmptyAttachmentsList,[nil]);
250
251	+	{make sure all attachments use same Firebird API}
252	+	for i := 0 to Length(Attachments) - 1 do
253	+	if Attachments[i].getFirebirdAPI.GetFBLibrary.GetHandle <> FFirebirdAPI.GetFBLibrary.GetHandle then
254	+	IBError(ibxeDifferentAPIs,[nil]);
255	+
256		SetLength(FAttachments,Length(Attachments));
257		for i := 0 to Length(Attachments) - 1 do
258		begin
#	Line 150 | Line 263 | begin
263		Start(DefaultCompletion);
264		end;
265
266	<	constructor TFBTransaction.Create(Attachment: IAttachment;
266	>	constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment;
267		Params: array of byte; DefaultCompletion: TTransactionAction);
268		begin
269	<	Create(Attachment,GenerateTPB(Params),DefaultCompletion);
269	>	Create(api,Attachment,GenerateTPB(Params),DefaultCompletion);
270		end;
271
272	<	constructor TFBTransaction.Create(Attachment: IAttachment; TPB: ITPB;
272	>	constructor TFBTransaction.Create(api: TFBClientAPI; Attachment: IAttachment; TPB: ITPB;
273		DefaultCompletion: TTransactionAction);
274		begin
275		inherited Create(nil);
276	+	SetInterface(api);
277		AddMonitor(GetActivityIntf(Attachment));
278		SetLength(FAttachments,1);
279		FAttachments[0] := Attachment;
#	Line 175 | Line 289 | end;
289
290		procedure TFBTransaction.DoDefaultTransactionEnd(Force: boolean);
291		var i: integer;
292	<	intf: TInterfacedObject;
292	>	intf: IUnknown;
293	>	user: ITransactionUser;
294		begin
295		if InTransaction then
296		begin
297		for i := 0 to InterfaceCount - 1 do
298		begin
299		intf := GetInterface(i);
300	<	if (intf <> nil) and  (intf is TFBStatement) then
301	<	TFBStatement(intf).TransactionEnding(self,Force);
300	>	if (intf <> nil) and  (intf.QueryInterface(ITransactionUser,user) = S_OK) then
301	>	user.TransactionEnding(self,Force);
302		end;
303		case FDefaultCompletion of
304		taRollback:
#	Line 199 | 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 219 | 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;
388	+	begin
389	+	Result :=  TPBPrefix + TPBConstantNames[getParamType];
390	+	end;
391	+
392	+
393	+	{TTPB}
394	+
395	+	constructor TTPB.Create(api: TFBClientAPI);
396	+	begin
397	+	inherited Create(api);
398	+	FDataLength := 1;
399	+	FBuffer^ := isc_tpb_version3;
400	+	end;
401	+
402	+	function TTPB.GetParamTypeName(ParamType: byte): Ansistring;
403	+	begin
404	+	if ParamType <= isc_tpb_last_tpb_constant then
405	+	Result := TPBConstantNames[ParamType]
406	+	else
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
421	+	Result := 0;
422	+	ParamTypeName := LowerCase(ParamTypeName);
423	+	if (Pos(TPBPrefix, ParamTypeName) = 1) then
424	+	Delete(ParamTypeName, 1, Length(TPBPrefix));
425	+
426	+	for i := 1 to isc_tpb_last_tpb_constant do
427	+	if (ParamTypeName = TPBConstantNames[i]) then
428	+	begin
429	+	Result := i;
430	+	break;
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