ViewVC Help

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

root/public/ibx/trunk/fbintf/client/3.0/FB30ClientAPI.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30ClientAPI.pas (file contents):
Revision 401 by tony, Mon Jan 10 10:13:17 2022 UTC vs.
Revision 402 by tony, Mon Aug 1 10:07:24 2022 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FB30ClientAPI;
28	<	{$IFDEF MSWINDOWS}
29	<	{$DEFINE WINDOWS}
28	>	{$IFDEF MSWINDOWS}
29	>	{$DEFINE WINDOWS}
30		{$ENDIF}
31
32		{$IFDEF FPC}
#	Line 41 | Line 41 | uses
41		FBActivityMonitor;
42
43		type
44	–
44		{ TFB30Status }
45
46		TFB30Status = class(TFBStatus,IStatus)
47		protected
48		FStatus: Firebird.IStatus;
49		FDirty: boolean;
50	+	function GetIBMessage: Ansistring; override;
51		public
52	+	constructor Create(aOwner: TFBClientAPI; prefix: AnsiString=''); overload;
53	+	constructor Create(aOwner: TFBClientAPI; aStatus: Firebird.IStatus); overload;
54	+	constructor Copy(src: TFB30Status);
55		destructor Destroy; override;
56	+	function Clone: IStatus; override;
57		procedure Init;
58		procedure FreeHandle;
59	<	function InErrorState: boolean;
59	>	function InErrorState: boolean; override;
60		function Warning: boolean;
61		function GetStatus: Firebird.IStatus;
62		function StatusVector: PStatusVector; override;
63		property Dirty: boolean read FDirty;
64		end;
65
62	–	{ TFB30StatusObject }
63	–
64	–	TFB30StatusObject = class(TFB30Status)
65	–	public
66	–	constructor Create(aOwner: TFBClientAPI; status: Firebird.IStatus; prefix: Ansistring='');
67	–	end;
68	–
66		Tfb_get_master_interface = function: IMaster;
67		{$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
68
#	Line 84 | Line 81 | type
81		goes out of scope.}
82		procedure CheckPlugins;
83		public
84	<	constructor Create(aFBLibrary: TFBLibrary);
84	>	constructor Create(aFBLibrary: TFBLibrary); overload;
85	>	constructor Create(aMaster: Firebird.IMaster); overload;
86		destructor Destroy; override;
87
88		function StatusIntf: Firebird.IStatus;
89		procedure Check4DataBaseError; overload;
90		procedure Check4DataBaseError(st: Firebird.IStatus); overload;
91	+	function FormatStatus(Status: Firebird.IStatus): AnsiString;
92		function InErrorState: boolean;
93		function LoadInterface: boolean; override;
94		procedure FBShutdown; override;
#	Line 111 | Line 110 | type
110		function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
111		{Start Transaction against multiple databases}
112		function StartTransaction(Attachments: array of IAttachment;
113	<	TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
113	>	TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; overload;
114		function StartTransaction(Attachments: array of IAttachment;
115	<	TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
115	>	TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString=''): ITransaction; overload;
116
117		{Service Manager}
118		function AllocateSPB: ISPB;
#	Line 146 | Line 145 | type
145		function SQLDecodeTime(bufptr: PByte): TDateTime;  override;
146		procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
147		function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
149	–	function FormatStatus(Status: TFBStatus): AnsiString; override;
150	–	function FormatFBStatus(Status: Firebird.IStatus): AnsiString;
148
149		{Firebird 4 Extensions}
150		procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte);
#	Line 256 | Line 253 | end;
253
254		{ TFB30StatusObject }
255
256	<	constructor TFB30StatusObject.Create(aOwner: TFBClientAPI;
257	<	status: Firebird.IStatus; prefix: Ansistring);
256	>	threadvar
257	>	PerThreadFirebirdStatusIntf: Firebird.IStatus;
258	>	StatusIntfRefCount: integer;
259	>
260	>	{ TFB30Status }
261	>
262	>	function TFB30Status.GetIBMessage: Ansistring;
263	>	begin
264	>	Result := (FOwner as TFB30ClientAPI).FormatStatus(GetStatus);
265	>	end;
266	>
267	>	constructor TFB30Status.Create(aOwner: TFBClientAPI; prefix: AnsiString);
268		begin
269		inherited Create(aOwner,prefix);
270	<	FStatus := status;
270	>	if aOwner <> nil then
271	>	begin
272	>	Inc(StatusIntfRefCount);
273	>	end;
274		end;
275
276	<	{ TFB30Status }
276	>	constructor TFB30Status.Create(aOwner: TFBClientAPI; aStatus: Firebird.IStatus);
277	>	begin
278	>	inherited Create(aOwner);
279	>	FStatus := aStatus.clone;
280	>	end;
281	>
282	>	constructor TFB30Status.Copy(src: TFB30Status);
283	>	begin
284	>	inherited Copy(src);
285	>	FStatus := src.GetStatus.clone;
286	>	end;
287
288		destructor TFB30Status.Destroy;
289		begin
#	Line 271 | Line 291 | begin
291		inherited Destroy;
292		end;
293
294	+	function TFB30Status.Clone: IStatus;
295	+	begin
296	+	Result := TFB30Status.Copy(self);
297	+	end;
298	+
299		procedure TFB30Status.Init;
300		begin
301	<	if assigned(FStatus) and Dirty then
301	>	if (GetStatus <> nil) and Dirty then
302		begin
303	<	FStatus.Init;
303	>	GetStatus.Init;
304		FDirty := false;
305		end;
306		end;
#	Line 285 | Line 310 | begin
310		if FStatus <> nil then
311		begin
312		FStatus.dispose;
313	<	FStatus := nil;
313	>	FStatus := nil
314	>	end
315	>	else
316	>	begin
317	>	Dec(StatusIntfRefCount);
318	>	if (StatusIntfRefCount = 0) and (PerThreadFirebirdStatusIntf <> nil) then
319	>	begin
320	>	PerThreadFirebirdStatusIntf.dispose();
321	>	PerThreadFirebirdStatusIntf := nil;
322	>	end;
323		end;
324		end;
325
#	Line 307 | Line 341 | end;
341
342		function TFB30Status.GetStatus: Firebird.IStatus;
343		begin
344	<	if FStatus = nil then
345	<	with FOwner do
346	<	FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
347	<	Result := FStatus;
344	>	if FStatus <> nil then
345	>	Result := FStatus
346	>	else
347	>	begin
348	>	{Create the FStatus per thread}
349	>	if PerThreadFirebirdStatusIntf = nil then
350	>	begin
351	>	with FOwner do
352	>	PerThreadFirebirdStatusIntf :=  (FOwner as TFB30ClientAPI).GetIMasterIntf.getStatus();
353	>	end;
354	>	Result := PerThreadFirebirdStatusIntf;
355	>	end;
356		end;
357
358		function TFB30Status.StatusVector: PStatusVector;
#	Line 364 | Line 406 | var
406		fb_get_master_interface: Tfb_get_master_interface;
407		begin
408		Result := inherited LoadInterface;
409	<	fb_get_master_interface := GetProcAddress(GetFBLibrary.GetHandle, 'fb_get_master_interface'); {do not localize}
410	<	if assigned(fb_get_master_interface) then
409	>	if (FMaster = nil) and (GetFBLibrary <> nil) then {get from library}
410	>	begin
411	>	fb_get_master_interface := GetProcAddress(GetFBLibrary.GetHandle, 'fb_get_master_interface'); {do not localize}
412	>	if assigned(fb_get_master_interface) then
413	>	FMaster := fb_get_master_interface;
414	>	end;
415	>	if FMaster <> nil then
416		begin
370	–	FMaster := fb_get_master_interface;
417		FUtil := FMaster.getUtilInterface;
418		FProvider := FMaster.getDispatcher;
419		FConfigManager := FMaster.getConfigManager;
#	Line 402 | Line 448 | begin
448		FStatusIntf := FStatus;
449		end;
450
451	+	constructor TFB30ClientAPI.Create(aMaster: Firebird.IMaster);
452	+	begin
453	+	inherited Create(nil);
454	+	FMaster := aMaster;
455	+	FStatus := TFB30Status.Create(self);
456	+	FStatusIntf := FStatus;
457	+	if FMaster <> nil then
458	+	begin
459	+	FUtil := FMaster.getUtilInterface;
460	+	FProvider := FMaster.getDispatcher;
461	+	FConfigManager := FMaster.getConfigManager;
462	+	CheckPlugins;
463	+	end;
464	+	end;
465	+
466		destructor TFB30ClientAPI.Destroy;
467		begin
468		FStatus.FreeHandle;
#	Line 423 | Line 484 | begin
484		end;
485
486		procedure TFB30ClientAPI.Check4DataBaseError(st: Firebird.IStatus);
487	+	var aStatus: IStatus;
488	+	begin
489	+	aStatus := TFB30Status.Create(self,st);
490	+	if aStatus.InErrorState then
491	+	raise EIBInterBaseError.Create(aStatus);
492	+	end;
493	+
494	+	function TFB30ClientAPI.FormatStatus(Status: Firebird.IStatus): AnsiString;
495	+	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
496		begin
497	<	if ((st.getState and st.STATE_ERRORS) <> 0) then
498	<	raise EIBInterBaseError.Create(TFB30StatusObject.Create(self,st));
497	>	Result := '';
498	>	if UtilIntf.formatStatus(@local_buffer,sizeof(local_buffer) - 1,Status) > 0 then
499	>	Result := strpas(local_buffer);
500		end;
501
502		function TFB30ClientAPI.InErrorState: boolean;
#	Line 473 | Line 544 | begin
544		end;
545
546		function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
547	<	TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
547	>	TPB: array of byte; DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
548		begin
549	<	Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
549	>	Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion,aName);
550		end;
551
552		function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
553	<	TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
553	>	TPB: ITPB; DefaultCompletion: TTransactionCompletion; aName: AnsiString): ITransaction;
554		begin
555	<	Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
555	>	Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion,aName);
556		end;
557
558		function TFB30ClientAPI.AllocateSPB: ISPB;
#	Line 600 | Line 671 | begin
671		Result := Result + SQLDecodeTime(bufPtr);
672		end;
673
603	–	function TFB30ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
604	–	begin
605	–	Result := FormatFBStatus((Status as TFB30Status).GetStatus);
606	–	end;
607	–
608	–	function TFB30ClientAPI.FormatFBStatus(Status: Firebird.IStatus): AnsiString;
609	–	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
610	–	begin
611	–	Result := '';
612	–	if UtilIntf.formatStatus(@local_buffer,sizeof(local_buffer) - 1,Status) > 0 then
613	–	Result := strpas(local_buffer);
614	–	end;
615	–
674		procedure TFB30ClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
675		bufptr: PByte);
676		var DecFloat16: IDecFloat16;
#	Line 801 | Line 859 | begin
859		Result := true;
860		end;
861
862	+	initialization
863	+	PerThreadFirebirdStatusIntf := nil;
864	+	StatusIntfRefCount := 0;
865		end.
866
867
868	+

Diff Legend

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