[ViewVC] Diff of: public/ibx/branches/udr/client/FBClientAPI.pas

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (file contents), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

#	Line 78 \| Line 78 \| uses
78		{$IFDEF FPC} Dynlibs, {$ENDIF}
79		IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals, FmtBCD;
80
81	<	{For Linux see result of GetFirebirdLibList method}
81	>	{For Linux see result of GetFirebirdLibListruntime/nongui/winipc.inc method}
82		{$IFDEF DARWIN}
83		const
84		FIREBIRD_SO2 = 'libfbclient.dylib';
#	Line 115 \| Line 115 \| type
115
116		{ TFBStatus }
117
118	<	TFBStatus = class(TFBInterfacedObject)
118	>	TFBStatus = class(TFBInterfacedObject, IStatus)
119		private
120		FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
121	+	FPrefix: AnsiString;
122	+	function SQLCodeSupported: boolean;
123		protected
124		FOwner: TFBClientAPI;
125	+	function GetIBMessage: Ansistring; virtual; abstract;
126	+	function GetSQLMessage: Ansistring;
127		public
128	<	constructor Create(aOwner: TFBClientAPI);
128	>	constructor Create(aOwner: TFBClientAPI; prefix: AnsiString='');
129		function StatusVector: PStatusVector; virtual; abstract;
130	+	procedure Assign(src: TFBStatus); virtual;
131	+	function Clone: IStatus; virtual; abstract;
132
133		{IStatus}
134	<	function GetIBErrorCode: Long;
135	<	function Getsqlcode: Long;
134	>	function GetIBErrorCode: TStatusCode;
135	>	function Getsqlcode: TStatusCode;
136		function GetMessage: AnsiString;
137		function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
138		function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
#	Line 193 \| Line 199 \| type
199
200		public
201		{Taken from legacy API}
196	–	isc_sqlcode: Tisc_sqlcode;
202		isc_sql_interprete: Tisc_sql_interprete;
203	<	isc_event_counts: Tisc_event_counts;
199	<	isc_event_block: Tisc_event_block;
200	<	isc_free: Tisc_free;
203	>	isc_sqlcode: Tisc_sqlcode;
204
205		constructor Create(aFBLibrary: TFBLibrary);
206		procedure IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 220 \| Line 223 \| type
223		property LocalTimeOffset: integer read FLocalTimeOffset;
224		public
225		{Encode/Decode}
226	<	procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
227	<	function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
226	>	procedure EncodeInteger(aValue: int64; len: integer; buffer: PByte);
227	>	function DecodeInteger(bufptr: PByte; len: short): int64;
228		procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
229		function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
230		procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
231		function SQLDecodeTime(bufptr: PByte): TDateTime; virtual; abstract;
232		procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
233		function SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
231	–	function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
234		function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
235		procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
236		virtual;
237		procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte); virtual;
238		function SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD; virtual;
237	–	function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
239
240		{IFirebirdAPI}
241		function GetStatus: IStatus; virtual; abstract;
#	Line 244 \| Line 245 \| type
245		function GetImplementationVersion: AnsiString;
246		function GetClientMajor: integer; virtual; abstract;
247		function GetClientMinor: integer; virtual; abstract;
248	<	end;
248	>	end;
249	>
250	>	IJournallingHook = interface
251	>	['{7d3e45e0-3628-416a-9e22-c20474825031}']
252	>	procedure TransactionStart(Tr: ITransaction);
253	>	function TransactionEnd(TransactionID: integer; Action: TTransactionAction): boolean;
254	>	procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction);
255	>	procedure ExecQuery(Stmt: IStatement);
256	>	end;
257
258		implementation
259
#	Line 402 \| Line 411 \| begin
411		raise EIBInterBaseError.Create(GetStatus);
412		end;
413
414	<	procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
414	>	procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
415		begin
416		while len > 0 do
417		begin
#	Line 413 \| Line 422 \| begin
422		end;
423		end;
424
425	+	(*
426	+	DecodeInteger is Translated from
427	+
428	+	SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
429	+	if (!ptr \|\| length <= 0 \|\| length > 8)
430	+	return 0;
431	+
432	+	SINT64 value = 0;
433	+	int shift = 0;
434	+
435	+	while (--length > 0)
436	+	{
437	+	value += ((SINT64) *ptr++) << shift;
438	+	shift += 8;
439	+	}
440	+
441	+	value += ((SINT64)(SCHAR) *ptr) << shift;
442	+
443	+	return value;
444	+	*)
445	+
446	+	function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
447	+	var shift: integer;
448	+	begin
449	+	Result := 0;
450	+	if (BufPtr = nil) or (len <= 0) or (len > 8) then
451	+	Exit;
452	+
453	+	shift := 0;
454	+	dec(len);
455	+	while len > 0 do
456	+	begin
457	+	Result := Result + (int64(bufptr^) shl shift);
458	+	Inc(bufptr);
459	+	shift := shift + 8;
460	+	dec(len);
461	+	end;
462	+	Result := Result + (int64(bufptr^) shl shift);
463	+	end;
464	+
465		function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
466		begin
467		if not HasInt128Support then
#	Line 459 \| Line 508 \| begin
508		end;
509
510		{$IFDEF UNIX}
511	+
512		procedure TFBClientAPI.GetTZDataSettings;
513		var S: TStringList;
514		begin
515		FLocalTimeOffset := GetLocalTimeOffset;
516	<	FLocalTimeZoneName := strpas(tzname[tzdaylight]);
516	>	{$if declared(Gettzname)}
517	>	FLocalTimeZoneName := Gettzname(tzdaylight);
518	>	{$else}
519	>	FLocalTimeZoneName := tzname[tzdaylight];
520	>	{$ifend}
521		FIsDaylightSavingsTime := tzdaylight;
522		if FileExists(DefaultTimeZoneFile) then
523		begin
#	Line 508 \| Line 562 \| end;
562
563		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
564		begin
565	<	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
565	>	Result := nil;
566	>	if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then
567	>	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
568		if not Assigned(Result) then
569		raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
570		end;
#	Line 547 \| Line 603 \| function TFBClientAPI.LoadInterface: boo
603		begin
604		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
605		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
550	–	isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
551	–	isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
552	–	isc_free := GetProcAddr('isc_free'); {do not localize}
606		fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
607	<	Result := assigned(isc_free);
607	>	Result := true; {don't case if these fail to load}
608		end;
609
610		procedure TFBClientAPI.FBShutdown;
#	Line 562 \| Line 615 \| end;
615
616		{ TFBStatus }
617
618	<	constructor TFBStatus.Create(aOwner: TFBClientAPI);
618	>	function TFBStatus.SQLCodeSupported: boolean;
619	>	begin
620	>	Result:= (FOwner <> nil) and assigned(FOwner.isc_sqlcode) and assigned(FOwner.isc_sql_interprete);
621	>	end;
622	>
623	>	function TFBStatus.GetSQLMessage: Ansistring;
624	>	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
625	>	begin
626	>	Result := '';
627	>	if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
628	>	begin
629	>	FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
630	>	Result := strpas(local_buffer);
631	>	end;
632	>	end;
633	>
634	>	constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
635		begin
636		inherited Create;
637		FOwner := aOwner;
638	<	FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
638	>	FPrefix := prefix;
639	>	FIBDataBaseErrorMessages := [ShowIBMessage];
640		end;
641
642	<	function TFBStatus.GetIBErrorCode: Long;
642	>	procedure TFBStatus.Assign(src: TFBStatus);
643	>	begin
644	>	FOwner := src.FOwner;
645	>	FPrefix := src.FPrefix;
646	>	SetIBDataBaseErrorMessages(src.GetIBDataBaseErrorMessages);
647	>	end;
648	>
649	>	function TFBStatus.GetIBErrorCode: TStatusCode;
650		begin
651		Result := StatusVector^[1];
652		end;
653
654	<	function TFBStatus.Getsqlcode: Long;
654	>	function TFBStatus.Getsqlcode: TStatusCode;
655		begin
656	<	with FOwner do
657	<	Result := isc_sqlcode(PISC_STATUS(StatusVector));
656	>	if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
657	>	Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
658	>	else
659	>	Result := -999; {generic SQL Code}
660		end;
661
662		function TFBStatus.GetMessage: AnsiString;
663	<	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
585	<	IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
586	<	sqlcode: Long;
663	>	var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
664		begin
665	<	Result := '';
665	>	Result := FPrefix;
666		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
667	<	sqlcode := Getsqlcode;
668	<	if (ShowSQLCode in IBDataBaseErrorMessages) then
669	<	Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
670	<
671	<	Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
672	<	if (ShowSQLMessage in IBDataBaseErrorMessages) then
673	<	begin
674	<	with FOwner do
675	<	isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
676	<	if (ShowSQLCode in FIBDataBaseErrorMessages) then
677	<	Result := Result + CRLF;
601	<	Result := Result + strpas(local_buffer);
667	>	if SQLCodeSupported then
668	>	begin
669	>	if (ShowSQLCode in IBDataBaseErrorMessages) then
670	>	Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
671	>
672	>	if (ShowSQLMessage in IBDataBaseErrorMessages) then
673	>	begin
674	>	if ShowSQLCode in IBDataBaseErrorMessages then
675	>	Result := Result + LineEnding;
676	>	Result := Result + GetSQLMessage;
677	>	end;
678		end;
679
680		if (ShowIBMessage in IBDataBaseErrorMessages) then
681		begin
682	<	if (ShowSQLCode in IBDataBaseErrorMessages) or
607	<	(ShowSQLMessage in IBDataBaseErrorMessages) then
682	>	if Result <> FPrefix then
683		Result := Result + LineEnding;
684	<	Result := Result + FOwner.FormatStatus(self);
684	>	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + LineEnding + GetIBMessage;
685		end;
686		if (Result <> '') and (Result[Length(Result)] = '.') then
687		Delete(Result, Length(Result), 1);

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

#	Line 0 \| Line 1
1	+	native

Diff Legend

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

Comparing: ibx/trunk/fbintf/client/FBClientAPI.pas (file contents), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs. ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

Comparing: ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs. ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

Diff Legend

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (file contents), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 386 by tony, Tue Jan 18 12:05:35 2022 UTC