ViewVC Help

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

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

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (file contents), Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 390 by tony, Sat Jan 22 16:15:12 2022 UTC

#	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; prefix: AnsiString='');
129	+	constructor Copy(src: TFBStatus);
130		function StatusVector: PStatusVector; virtual; abstract;
131	+	function Clone: IStatus; virtual; abstract;
132
133		{IStatus}
134	+	function InErrorState: boolean; virtual; abstract;
135		function GetIBErrorCode: TStatusCode;
136		function Getsqlcode: TStatusCode;
137		function GetMessage: AnsiString;
#	Line 194 | Line 200 | type
200
201		public
202		{Taken from legacy API}
197	–	isc_sqlcode: Tisc_sqlcode;
203		isc_sql_interprete: Tisc_sql_interprete;
204	<	isc_event_counts: Tisc_event_counts;
200	<	isc_event_block: Tisc_event_block;
201	<	isc_free: Tisc_free;
202	<	isc_portable_integer: Tisc_portable_integer;
204	>	isc_sqlcode: Tisc_sqlcode;
205
206		constructor Create(aFBLibrary: TFBLibrary);
207		procedure IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 222 | Line 224 | type
224		property LocalTimeOffset: integer read FLocalTimeOffset;
225		public
226		{Encode/Decode}
227	<	procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
227	>	procedure EncodeInteger(aValue: int64; len: integer; buffer: PByte);
228		function DecodeInteger(bufptr: PByte; len: short): int64;
229		procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte);  virtual; abstract;
230		function SQLDecodeDate(byfptr: PByte): TDateTime;  virtual; abstract;
#	Line 230 | Line 232 | type
232		function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
233		procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
234		function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
233	–	function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
235		function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
236		procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
237		virtual;
#	Line 245 | Line 246 | type
246		function GetImplementationVersion: AnsiString;
247		function GetClientMajor: integer;  virtual; abstract;
248		function GetClientMinor: integer;  virtual; abstract;
249	<	end;
249	>	end;
250	>
251	>	IJournallingHook = interface
252	>	['{7d3e45e0-3628-416a-9e22-c20474825031}']
253	>	procedure TransactionStart(Tr: ITransaction);
254	>	function TransactionEnd(TransactionID: integer; Completion: TTrCompletionState): boolean;
255	>	procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction);
256	>	procedure ExecQuery(Stmt: IStatement);
257	>	procedure ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
258	>	end;
259
260		implementation
261
#	Line 403 | Line 413 | begin
413		raise EIBInterBaseError.Create(GetStatus);
414		end;
415
416	<	procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
416	>	procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
417		begin
418		while len > 0 do
419		begin
#	Line 414 | Line 424 | begin
424		end;
425		end;
426
427	+	(*
428	+	DecodeInteger is Translated from
429	+
430	+	SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
431	+	if (!ptr || length <= 0 || length > 8)
432	+	return 0;
433	+
434	+	SINT64 value = 0;
435	+	int shift = 0;
436	+
437	+	while (--length > 0)
438	+	{
439	+	value += ((SINT64) *ptr++) << shift;
440	+	shift += 8;
441	+	}
442	+
443	+	value += ((SINT64)(SCHAR) *ptr) << shift;
444	+
445	+	return value;
446	+	*)
447	+
448		function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
449	+	var shift: integer;
450		begin
451	<	Result := isc_portable_integer(bufptr,len);
451	>	Result := 0;
452	>	if (BufPtr = nil) or (len <= 0) or (len > 8) then
453	>	Exit;
454	>
455	>	shift := 0;
456	>	dec(len);
457	>	while len > 0 do
458	>	begin
459	>	Result := Result + (int64(bufptr^) shl shift);
460	>	Inc(bufptr);
461	>	shift := shift + 8;
462	>	dec(len);
463	>	end;
464	>	Result := Result + (int64(bufptr^) shl shift);
465		end;
466
467		function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
#	Line 465 | Line 510 | begin
510		end;
511
512		{$IFDEF UNIX}
513	+
514		procedure TFBClientAPI.GetTZDataSettings;
515		var S: TStringList;
516		begin
517		FLocalTimeOffset := GetLocalTimeOffset;
518	<	FLocalTimeZoneName := strpas(tzname[tzdaylight]);
518	>	{$if declared(Gettzname)}
519	>	FLocalTimeZoneName := Gettzname(tzdaylight);
520	>	{$else}
521	>	FLocalTimeZoneName := tzname[tzdaylight];
522	>	{$ifend}
523		FIsDaylightSavingsTime := tzdaylight;
524		if FileExists(DefaultTimeZoneFile) then
525		begin
#	Line 555 | Line 605 | function TFBClientAPI.LoadInterface: boo
605		begin
606		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
607		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
558	–	isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
559	–	isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
560	–	isc_free := GetProcAddr('isc_free'); {do not localize}
561	–	isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
608		fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
609	<	Result := assigned(isc_free);
609	>	Result := true; {don't case if these fail to load}
610		end;
611
612		procedure TFBClientAPI.FBShutdown;
#	Line 571 | Line 617 | end;
617
618		{ TFBStatus }
619
620	+	function TFBStatus.SQLCodeSupported: boolean;
621	+	begin
622	+	Result:= (FOwner <> nil) and assigned(FOwner.isc_sqlcode) and  assigned(FOwner.isc_sql_interprete);
623	+	end;
624	+
625	+	function TFBStatus.GetSQLMessage: Ansistring;
626	+	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
627	+	begin
628	+	Result := '';
629	+	if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
630	+	begin
631	+	FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
632	+	Result := strpas(local_buffer);
633	+	end;
634	+	end;
635	+
636		constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
637		begin
638		inherited Create;
639		FOwner := aOwner;
640		FPrefix := prefix;
641	<	FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
641	>	FIBDataBaseErrorMessages := [ShowIBMessage];
642	>	end;
643	>
644	>	constructor TFBStatus.Copy(src: TFBStatus);
645	>	begin
646	>	inherited Create;
647	>	FOwner := src.FOwner;
648	>	FPrefix := src.FPrefix;
649	>	SetIBDataBaseErrorMessages(src.GetIBDataBaseErrorMessages);
650		end;
651
652		function TFBStatus.GetIBErrorCode: TStatusCode;
#	Line 586 | Line 656 | end;
656
657		function TFBStatus.Getsqlcode: TStatusCode;
658		begin
659	<	with FOwner do
660	<	Result := isc_sqlcode(PISC_STATUS(StatusVector));
659	>	if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
660	>	Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
661	>	else
662	>	Result := -999; {generic SQL Code}
663		end;
664
665		function TFBStatus.GetMessage: AnsiString;
666	<	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
595	<	IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
596	<	sqlcode: Long;
666	>	var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
667		begin
668		Result := FPrefix;
669		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
670	<	sqlcode := Getsqlcode;
671	<	if (ShowSQLCode in IBDataBaseErrorMessages) then
672	<	Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
673	<
674	<	if (ShowSQLMessage in IBDataBaseErrorMessages) then
675	<	begin
676	<	with FOwner do
677	<	isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
678	<	if (ShowSQLCode in FIBDataBaseErrorMessages) then
679	<	Result := Result + LineEnding;
680	<	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
670	>	if SQLCodeSupported then
671	>	begin
672	>	if (ShowSQLCode in IBDataBaseErrorMessages) then
673	>	Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
674	>
675	>	if (ShowSQLMessage in IBDataBaseErrorMessages) then
676	>	begin
677	>	if ShowSQLCode in IBDataBaseErrorMessages then
678	>	Result := Result + LineEnding;
679	>	Result := Result + GetSQLMessage;
680	>	end;
681		end;
682
683		if (ShowIBMessage in IBDataBaseErrorMessages) then
684		begin
685	<	if (ShowSQLCode in IBDataBaseErrorMessages) or
616	<	(ShowSQLMessage in IBDataBaseErrorMessages) then
685	>	if Result <> FPrefix then
686		Result := Result + LineEnding;
687	<	Result := Result + FOwner.FormatStatus(self);
687	>	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + LineEnding + GetIBMessage;
688		end;
689		if (Result <> '') and (Result[Length(Result)] = '.') then
690		Delete(Result, Length(Result), 1);

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 390 by tony, Sat Jan 22 16:15:12 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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