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 316 by tony, Thu Feb 25 11:59:00 2021 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 371 by tony, Wed Jan 5 15:21:22 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 118 | Line 118 | type
118		TFBStatus = class(TFBInterfacedObject)
119		private
120		FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
121	+	FPrefix: AnsiString;
122		protected
123		FOwner: TFBClientAPI;
124	+	function GetIBMessage: Ansistring; virtual; abstract;
125	+	function GetSQLMessage: Ansistring;
126		public
127	<	constructor Create(aOwner: TFBClientAPI);
127	>	constructor Create(aOwner: TFBClientAPI; prefix: AnsiString='');
128		function StatusVector: PStatusVector; virtual; abstract;
129
130		{IStatus}
131	<	function GetIBErrorCode: Long;
132	<	function Getsqlcode: Long;
131	>	function GetIBErrorCode: TStatusCode;
132	>	function Getsqlcode: TStatusCode;
133		function GetMessage: AnsiString;
134		function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
135		function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
#	Line 193 | Line 196 | type
196
197		public
198		{Taken from legacy API}
196	–	isc_sqlcode: Tisc_sqlcode;
199		isc_sql_interprete: Tisc_sql_interprete;
200	<	isc_event_counts: Tisc_event_counts;
199	<	isc_event_block: Tisc_event_block;
200	<	isc_free: Tisc_free;
200	>	isc_sqlcode: Tisc_sqlcode;
201
202		constructor Create(aFBLibrary: TFBLibrary);
203		procedure IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 220 | Line 220 | type
220		property LocalTimeOffset: integer read FLocalTimeOffset;
221		public
222		{Encode/Decode}
223	<	procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
224	<	function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
223	>	procedure EncodeInteger(aValue: int64; len: integer; buffer: PByte);
224	>	function DecodeInteger(bufptr: PByte; len: short): int64;
225		procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte);  virtual; abstract;
226		function SQLDecodeDate(byfptr: PByte): TDateTime;  virtual; abstract;
227		procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte);  virtual; abstract;
228		function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
229		procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
230		function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
231	–	function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
231		function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
232		procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
233		virtual;
#	Line 243 | Line 242 | type
242		function GetImplementationVersion: AnsiString;
243		function GetClientMajor: integer;  virtual; abstract;
244		function GetClientMinor: integer;  virtual; abstract;
245	<	end;
245	>	end;
246	>
247	>	IJournallingHook = interface
248	>	['{7d3e45e0-3628-416a-9e22-c20474825031}']
249	>	procedure TransactionStart(Tr: ITransaction);
250	>	function TransactionEnd(TransactionID: integer; Action: TTransactionAction): boolean;
251	>	procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer; Action: TTransactionAction);
252	>	procedure ExecQuery(Stmt: IStatement);
253	>	end;
254
255		implementation
256
#	Line 401 | Line 408 | begin
408		raise EIBInterBaseError.Create(GetStatus);
409		end;
410
411	<	procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
411	>	procedure TFBClientAPI.EncodeInteger(aValue: int64; len: integer; buffer: PByte);
412		begin
413		while len > 0 do
414		begin
#	Line 412 | Line 419 | begin
419		end;
420		end;
421
422	+	(*
423	+	DecodeInteger is Translated from
424	+
425	+	SINT64 API_ROUTINE isc_portable_integer(const UCHAR* ptr, SSHORT length)
426	+	if (!ptr || length <= 0 || length > 8)
427	+	return 0;
428	+
429	+	SINT64 value = 0;
430	+	int shift = 0;
431	+
432	+	while (--length > 0)
433	+	{
434	+	value += ((SINT64) *ptr++) << shift;
435	+	shift += 8;
436	+	}
437	+
438	+	value += ((SINT64)(SCHAR) *ptr) << shift;
439	+
440	+	return value;
441	+	*)
442	+
443	+	function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
444	+	var shift: integer;
445	+	begin
446	+	Result := 0;
447	+	if (BufPtr = nil) or (len <= 0) or (len > 8) then
448	+	Exit;
449	+
450	+	shift := 0;
451	+	dec(len);
452	+	while len > 0 do
453	+	begin
454	+	Result := Result + (int64(bufptr^) shl shift);
455	+	Inc(bufptr);
456	+	shift := shift + 8;
457	+	dec(len);
458	+	end;
459	+	Result := Result + (int64(bufptr^) shl shift);
460	+	end;
461	+
462		function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
463		begin
464		if not HasInt128Support then
#	Line 458 | Line 505 | begin
505		end;
506
507		{$IFDEF UNIX}
508	+
509		procedure TFBClientAPI.GetTZDataSettings;
510		var S: TStringList;
511		begin
512		FLocalTimeOffset := GetLocalTimeOffset;
513	<	FLocalTimeZoneName := strpas(tzname[tzdaylight]);
513	>	{$if declared(Gettzname)}
514	>	FLocalTimeZoneName := Gettzname(tzdaylight);
515	>	{$else}
516	>	FLocalTimeZoneName := tzname[tzdaylight];
517	>	{$ifend}
518		FIsDaylightSavingsTime := tzdaylight;
519		if FileExists(DefaultTimeZoneFile) then
520		begin
#	Line 507 | Line 559 | end;
559
560		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
561		begin
562	<	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
562	>	Result := nil;
563	>	if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then
564	>	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
565		if not Assigned(Result) then
566		raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
567		end;
#	Line 546 | Line 600 | function TFBClientAPI.LoadInterface: boo
600		begin
601		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
602		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
549	–	isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
550	–	isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
551	–	isc_free := GetProcAddr('isc_free'); {do not localize}
603		fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
604	<	Result := assigned(isc_free);
604	>	Result := true; {don't case if these fail to load}
605		end;
606
607		procedure TFBClientAPI.FBShutdown;
#	Line 561 | Line 612 | end;
612
613		{ TFBStatus }
614
615	<	constructor TFBStatus.Create(aOwner: TFBClientAPI);
615	>	function TFBStatus.GetSQLMessage: Ansistring;
616	>	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
617	>	begin
618	>	Result := '';
619	>	if (FOwner <> nil) and assigned(FOwner.isc_sql_interprete) then
620	>	begin
621	>	FOwner.isc_sql_interprete(Getsqlcode, local_buffer, sizeof(local_buffer));
622	>	Result := strpas(local_buffer);
623	>	end;
624	>	end;
625	>
626	>	constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
627		begin
628		inherited Create;
629		FOwner := aOwner;
630	<	FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
630	>	FPrefix := prefix;
631	>	FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
632		end;
633
634	<	function TFBStatus.GetIBErrorCode: Long;
634	>	function TFBStatus.GetIBErrorCode: TStatusCode;
635		begin
636		Result := StatusVector^[1];
637		end;
638
639	<	function TFBStatus.Getsqlcode: Long;
639	>	function TFBStatus.Getsqlcode: TStatusCode;
640		begin
641	<	with FOwner do
642	<	Result := isc_sqlcode(PISC_STATUS(StatusVector));
641	>	if (FOwner <> nil) and assigned(FOwner.isc_sqlcode) then
642	>	Result := FOwner.isc_sqlcode(PISC_STATUS(StatusVector))
643	>	else
644	>	Result := -999; {generic SQL Code}
645		end;
646
647		function TFBStatus.GetMessage: AnsiString;
648	<	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
584	<	IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
585	<	sqlcode: Long;
648	>	var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
649		begin
650	<	Result := '';
650	>	Result := FPrefix;
651		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
589	–	sqlcode := Getsqlcode;
652		if (ShowSQLCode in IBDataBaseErrorMessages) then
653	<	Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
653	>	Result := Result + 'SQLCODE: ' + IntToStr(Getsqlcode); {do not localize}
654
655	<	Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
594	<	if (ShowSQLMessage in IBDataBaseErrorMessages) then
655	>	if [ShowSQLMessage, ShowIBMessage]*IBDataBaseErrorMessages <> [] then
656		begin
596	–	with FOwner do
597	–	isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
657		if (ShowSQLCode in FIBDataBaseErrorMessages) then
658	<	Result := Result + CRLF;
659	<	Result := Result + strpas(local_buffer);
658	>	Result := Result + LineEnding;
659	>	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ';
660		end;
661
662	+	if (ShowSQLMessage in IBDataBaseErrorMessages) then
663	+	Result := Result + GetSQLMessage;
664	+
665		if (ShowIBMessage in IBDataBaseErrorMessages) then
666		begin
667	<	if (ShowSQLCode in IBDataBaseErrorMessages) or
606	<	(ShowSQLMessage in IBDataBaseErrorMessages) then
667	>	if ShowSQLMessage in IBDataBaseErrorMessages then
668		Result := Result + LineEnding;
669	<	Result := Result + FOwner.FormatStatus(self);
669	>	Result := Result + GetIBMessage;
670		end;
671		if (Result <> '') and (Result[Length(Result)] = '.') then
672		Delete(Result, Length(Result), 1);

Diff Legend

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