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 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 387 by tony, Wed Jan 19 13:34:42 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		function StatusVector: PStatusVector; virtual; abstract;
130	+	procedure Assign(src: TFBStatus); virtual;
131	+	function Clone: IStatus; virtual; abstract;
132
133		{IStatus}
134		function GetIBErrorCode: TStatusCode;
#	Line 194 | Line 199 | type
199
200		public
201		{Taken from legacy API}
197	–	isc_sqlcode: Tisc_sqlcode;
202		isc_sql_interprete: Tisc_sql_interprete;
203	<	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;
203	>	isc_sqlcode: Tisc_sqlcode;
204
205		constructor Create(aFBLibrary: TFBLibrary);
206		procedure IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 222 | Line 223 | type
223		property LocalTimeOffset: integer read FLocalTimeOffset;
224		public
225		{Encode/Decode}
226	<	procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
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;
#	Line 230 | Line 231 | type
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;
233	–	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;
#	Line 245 | 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; Completion: TTrCompletionState): boolean;
254	>	procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction);
255	>	procedure ExecQuery(Stmt: IStatement);
256	>	procedure ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
257	>	end;
258
259		implementation
260
#	Line 403 | Line 412 | begin
412		raise EIBInterBaseError.Create(GetStatus);
413		end;
414
415	<	procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
415	>	procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
416		begin
417		while len > 0 do
418		begin
#	Line 414 | Line 423 | begin
423		end;
424		end;
425
426	+	(*
427	+	DecodeInteger is Translated from
428	+
429	+	SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
430	+	if (!ptr || length <= 0 || length > 8)
431	+	return 0;
432	+
433	+	SINT64 value = 0;
434	+	int shift = 0;
435	+
436	+	while (--length > 0)
437	+	{
438	+	value += ((SINT64) *ptr++) << shift;
439	+	shift += 8;
440	+	}
441	+
442	+	value += ((SINT64)(SCHAR) *ptr) << shift;
443	+
444	+	return value;
445	+	*)
446	+
447		function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
448	+	var shift: integer;
449		begin
450	<	Result := isc_portable_integer(bufptr,len);
450	>	Result := 0;
451	>	if (BufPtr = nil) or (len <= 0) or (len > 8) then
452	>	Exit;
453	>
454	>	shift := 0;
455	>	dec(len);
456	>	while len > 0 do
457	>	begin
458	>	Result := Result + (int64(bufptr^) shl shift);
459	>	Inc(bufptr);
460	>	shift := shift + 8;
461	>	dec(len);
462	>	end;
463	>	Result := Result + (int64(bufptr^) shl shift);
464		end;
465
466		function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
#	Line 465 | Line 509 | begin
509		end;
510
511		{$IFDEF UNIX}
512	+
513		procedure TFBClientAPI.GetTZDataSettings;
514		var S: TStringList;
515		begin
516		FLocalTimeOffset := GetLocalTimeOffset;
517	<	FLocalTimeZoneName := strpas(tzname[tzdaylight]);
517	>	{$if declared(Gettzname)}
518	>	FLocalTimeZoneName := Gettzname(tzdaylight);
519	>	{$else}
520	>	FLocalTimeZoneName := tzname[tzdaylight];
521	>	{$ifend}
522		FIsDaylightSavingsTime := tzdaylight;
523		if FileExists(DefaultTimeZoneFile) then
524		begin
#	Line 514 | Line 563 | end;
563
564		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
565		begin
566	<	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
566	>	Result := nil;
567	>	if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then
568	>	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
569		if not Assigned(Result) then
570		raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
571		end;
#	Line 553 | Line 604 | function TFBClientAPI.LoadInterface: boo
604		begin
605		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
606		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
556	–	isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
557	–	isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
558	–	isc_free := GetProcAddr('isc_free'); {do not localize}
559	–	isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
607		fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
608	<	Result := assigned(isc_free);
608	>	Result := true; {don't case if these fail to load}
609		end;
610
611		procedure TFBClientAPI.FBShutdown;
#	Line 569 | Line 616 | end;
616
617		{ TFBStatus }
618
619	+	function TFBStatus.SQLCodeSupported: boolean;
620	+	begin
621	+	Result:= (FOwner <> nil) and assigned(FOwner.isc_sqlcode) and  assigned(FOwner.isc_sql_interprete);
622	+	end;
623	+
624	+	function TFBStatus.GetSQLMessage: Ansistring;
625	+	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
626	+	begin
627	+	Result := '';
628	+	if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
629	+	begin
630	+	FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
631	+	Result := strpas(local_buffer);
632	+	end;
633	+	end;
634	+
635		constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
636		begin
637		inherited Create;
638		FOwner := aOwner;
639		FPrefix := prefix;
640	<	FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
640	>	FIBDataBaseErrorMessages := [ShowIBMessage];
641	>	end;
642	>
643	>	procedure TFBStatus.Assign(src: TFBStatus);
644	>	begin
645	>	FOwner := src.FOwner;
646	>	FPrefix := src.FPrefix;
647	>	SetIBDataBaseErrorMessages(src.GetIBDataBaseErrorMessages);
648		end;
649
650		function TFBStatus.GetIBErrorCode: TStatusCode;
#	Line 584 | Line 654 | end;
654
655		function TFBStatus.Getsqlcode: TStatusCode;
656		begin
657	<	with FOwner do
658	<	Result := isc_sqlcode(PISC_STATUS(StatusVector));
657	>	if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
658	>	Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
659	>	else
660	>	Result := -999; {generic SQL Code}
661		end;
662
663		function TFBStatus.GetMessage: AnsiString;
664	<	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
593	<	IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
594	<	sqlcode: Long;
664	>	var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
665		begin
666		Result := FPrefix;
667		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
668	<	sqlcode := Getsqlcode;
669	<	if (ShowSQLCode in IBDataBaseErrorMessages) then
670	<	Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
671	<
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 + LineEnding;
678	<	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
668	>	if SQLCodeSupported then
669	>	begin
670	>	if (ShowSQLCode in IBDataBaseErrorMessages) then
671	>	Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
672	>
673	>	if (ShowSQLMessage in IBDataBaseErrorMessages) then
674	>	begin
675	>	if ShowSQLCode in IBDataBaseErrorMessages then
676	>	Result := Result + LineEnding;
677	>	Result := Result + GetSQLMessage;
678	>	end;
679		end;
680
681		if (ShowIBMessage in IBDataBaseErrorMessages) then
682		begin
683	<	if (ShowSQLCode in IBDataBaseErrorMessages) or
614	<	(ShowSQLMessage in IBDataBaseErrorMessages) then
683	>	if Result <> FPrefix then
684		Result := Result + LineEnding;
685	<	Result := Result + FOwner.FormatStatus(self);
685	>	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + LineEnding + GetIBMessage;
686		end;
687		if (Result <> '') and (Result[Length(Result)] = '.') then
688		Delete(Result, Length(Result), 1);

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 387 by tony, Wed Jan 19 13:34:42 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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