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

Comparing ibx/trunk/fbintf/client/FBClientAPI.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 2021 UTC

#	Line 76 \| Line 76 \| uses
76		Classes,
77		{$IFDEF WINDOWS}Windows, {$ENDIF}
78		{$IFDEF FPC} Dynlibs, {$ENDIF}
79	<	IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals;
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 90 \| Line 90 \| FIREBIRD_CLIENT = 'fbclient.dll'; {do no
90		FIREBIRD_EMBEDDED = 'fbembed.dll';
91		{$ENDIF}
92
93	+	const
94	+	{fb_shutdown reasons}
95	+	fb_shutrsn_svc_stopped = -1;
96	+	fb_shutrsn_no_connection = -2;
97	+	fb_shutrsn_app_stopped = -3;
98	+	fb_shutrsn_signal = -5;
99	+	fb_shutrsn_services = -6;
100	+	fb_shutrsn_exit_called = -7;
101	+
102	+	const
103	+	DefaultTimeZoneFile = '/etc/timezone';
104	+
105	+	const
106	+	IBLocalBufferLength = 512;
107	+	IBBigLocalBufferLength = IBLocalBufferLength * 2;
108	+	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
109	+
110		type
111		TStatusVector = array[0..19] of NativeInt;
112		PStatusVector = ^TStatusVector;
#	Line 101 \| Line 118 \| type
118		TFBStatus = class(TFBInterfacedObject)
119		private
120		FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
121	+	FPrefix: AnsiString;
122		protected
123		FOwner: TFBClientAPI;
124		public
125	<	constructor Create(aOwner: TFBClientAPI);
125	>	constructor Create(aOwner: TFBClientAPI; prefix: AnsiString='');
126		function StatusVector: PStatusVector; virtual; abstract;
127
128		{IStatus}
129	<	function GetIBErrorCode: Long;
130	<	function Getsqlcode: Long;
129	>	function GetIBErrorCode: TStatusCode;
130	>	function Getsqlcode: TStatusCode;
131		function GetMessage: AnsiString;
132		function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
133		function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
#	Line 122 \| Line 140 \| type
140		private
141		class var FEnvSetupDone: boolean;
142		class var FLibraryList: array of IFirebirdLibrary;
143	+	private
144		FFirebirdAPI: IFirebirdAPI;
145		FRequestedLibName: string;
146		function LoadIBLibrary: boolean;
#	Line 139 \| Line 158 \| type
158		destructor Destroy; override;
159		class function GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
160		class procedure FreeLibraries;
161	+	function SameLibrary(aLibName: string): boolean;
162
163	+	public
164		{IFirebirdLibrary}
165		function GetHandle: TLibHandle;
166		function GetLibraryName: string;
#	Line 152 \| Line 173 \| type
173
174		TFBClientAPI = class(TFBInterfacedObject)
175		private
176	+	FLocalTimeZoneName: AnsiString; {Informal Time Zone Name from tzname e.g. GMT or BST}
177	+	FTZDataTimeZoneID: AnsiString; {TZData DB ID e.g. Europe/London}
178	+	FLocalTimeOffset: integer;
179	+	FIsDaylightSavingsTime: boolean;
180		class var FIBCS: TRTLCriticalSection;
181	+	function FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
182	+	procedure GetTZDataSettings;
183		protected
184		FFBLibrary: TFBLibrary;
185		function GetProcAddr(ProcName: PAnsiChar): Pointer;
186	+
187	+	protected type
188	+	Tfb_shutdown = function (timeout: uint;
189	+	const reason: int): int;
190	+	{$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
191	+	protected
192	+	{FB Shutdown API}
193	+	fb_shutdown: Tfb_shutdown;
194	+
195		public
196		{Taken from legacy API}
197		isc_sqlcode: Tisc_sqlcode;
198		isc_sql_interprete: Tisc_sql_interprete;
163	–	isc_interprete: Tisc_interprete;
199		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
204		constructor Create(aFBLibrary: TFBLibrary);
205		procedure IBAlloc(var P; OldSize, NewSize: Integer);
206		procedure IBDataBaseError;
207		function LoadInterface: boolean; virtual;
208	+	procedure FBShutdown; virtual;
209		function GetAPI: IFirebirdAPI; virtual; abstract;
210		{$IFDEF UNIX}
211		function GetFirebirdLibList: string; virtual; abstract;
212		{$ENDIF}
213	+	function HasDecFloatSupport: boolean;
214	+	function HasInt128Support: boolean; virtual;
215	+	function HasLocalTZDB: boolean; virtual;
216	+	function HasExtendedTZSupport: boolean; virtual;
217	+	function HasTimeZoneSupport: boolean; virtual;
218
219	+	public
220	+	property LocalTimeZoneName: AnsiString read FLocalTimeZoneName;
221	+	property TZDataTimeZoneID: AnsiString read FTZDataTimeZoneID;
222	+	property LocalTimeOffset: integer read FLocalTimeOffset;
223	+	public
224		{Encode/Decode}
225		procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
226	<	function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
227	<	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
228	<	function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
229	<	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
226	>	function DecodeInteger(bufptr: PByte; len: short): int64;
227	>	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
228	>	function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
229	>	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
230		function SQLDecodeTime(bufptr: PByte): TDateTime; virtual; abstract;
231		procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
232	<	function SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
233	<
232	>	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;
237	>	procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte); virtual;
238	>	function SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD; virtual;
239
240		{IFirebirdAPI}
241		function GetStatus: IStatus; virtual; abstract;
242		function IsLibraryLoaded: boolean;
243		function IsEmbeddedServer: boolean; virtual; abstract;
244		function GetFBLibrary: IFirebirdLibrary;
245	+	function GetImplementationVersion: AnsiString;
246	+	function GetClientMajor: integer; virtual; abstract;
247	+	function GetClientMinor: integer; virtual; abstract;
248		end;
249
250		implementation
251
252		uses IBUtils, Registry,
253	<	{$IFDEF Unix} initc, dl, {$ENDIF}
253	>	{$IFDEF Unix} unix, initc, dl, {$ENDIF}
254		{$IFDEF FPC}
255		{$IFDEF WINDOWS }
256		WinDirs,
#	Line 205 \| Line 260 \| WinDirs,
260		{$ENDIF}
261		SysUtils;
262
208	–	const
209	–	IBLocalBufferLength = 512;
210	–	IBBigLocalBufferLength = IBLocalBufferLength * 2;
211	–	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
212	–
263		{$IFDEF UNIX}
264		{$I 'include/uloadlibrary.inc'}
265		{$ELSE}
#	Line 233 \| Line 283 \| end;
283
284		procedure TFBLibrary.FreeFBLibrary;
285		begin
286	+	(FFirebirdAPI as TFBClientAPI).FBShutdown;
287		if FIBLibrary <> NilHandle then
288		FreeLibrary(FIBLibrary);
289		FIBLibrary := NilHandle;
290	+	FFBLibraryName := '';
291		end;
292
293		function TFBLibrary.GetLibraryName: string;
#	Line 287 \| Line 339 \| end;
339
340		destructor TFBLibrary.Destroy;
341		begin
290	–	FFirebirdAPI := nil;
342		FreeFBLibrary;
343	+	FFirebirdAPI := nil;
344		inherited Destroy;
345		end;
346
#	Line 299 \| Line 351 \| begin
351		if aLibPathName <> '' then
352		begin
353		for i := 0 to Length(FLibraryList) - 1 do
354	<	if (FLibraryList[i] as TFBLibrary).FRequestedLibName = aLibPathName then
354	>	begin
355	>	if (FLibraryList[i] as TFBLibrary).SameLibrary(aLibPathName) then
356		begin
357		Result := FLibraryList[i];
358		Exit;
359		end;
360	+	end;
361		Result := Create(aLibPathName);
362		end;
363
#	Line 317 \| Line 371 \| begin
371		SetLength(FLibraryList,0);
372		end;
373
374	+	function TFBLibrary.SameLibrary(aLibName: string): boolean;
375	+	begin
376	+	Result := FRequestedLibName = aLibName;
377	+	end;
378	+
379		function TFBLibrary.GetHandle: TLibHandle;
380		begin
381		Result := FIBLibrary;
#	Line 328 \| Line 387 \| constructor TFBClientAPI.Create(aFBLibra
387		begin
388		inherited Create;
389		FFBLibrary := aFBLibrary;
390	+	GetTZDataSettings;
391		end;
392
393		procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 343 \| Line 403 \| begin
403		raise EIBInterBaseError.Create(GetStatus);
404		end;
405
346	–	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
347	–
406		procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
407		begin
408		while len > 0 do
#	Line 356 \| Line 414 \| begin
414		end;
415		end;
416
417	+	function TFBClientAPI.DecodeInteger(bufptr: PByte; len: short): int64;
418	+	begin
419	+	Result := isc_portable_integer(bufptr,len);
420	+	end;
421	+
422	+	function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
423	+	begin
424	+	if not HasInt128Support then
425	+	IBError(ibxeNotSupported,[]);
426	+	end;
427	+
428	+	procedure TFBClientAPI.StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
429	+	begin
430	+	if not HasInt128Support then
431	+	IBError(ibxeNotSupported,[]);
432	+	end;
433	+
434	+	procedure TFBClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
435	+	bufptr: PByte);
436	+	begin
437	+	if not HasDecFloatSupport then
438	+	IBError(ibxeNotSupported,[]);
439	+	end;
440	+
441	+	function TFBClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;
442	+	begin
443	+	if not HasDecFloatSupport then
444	+	IBError(ibxeNotSupported,[]);
445	+	end;
446	+
447		function TFBClientAPI.IsLibraryLoaded: boolean;
448		begin
449		Result := FFBLibrary.IBLibrary <> NilHandle;
#	Line 366 \| Line 454 \| begin
454		Result := FFBLibrary;
455		end;
456
457	+	function TFBClientAPI.FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
458	+	begin
459	+	{aDate/aTime are in TTimestamp format but aTime is decimilliseconds}
460	+	aDate := aDate - DateDelta;
461	+	if aDate < 0 then
462	+	Result := trunc(aDate) - abs(frac(aTime / (MSecsPerDay*10)))
463	+	else
464	+	Result := trunc(aDate) + abs(frac(aTime / (MSecsPerDay*10)));
465	+	end;
466	+
467	+	{$IFDEF UNIX}
468	+
469	+	procedure TFBClientAPI.GetTZDataSettings;
470	+	var S: TStringList;
471	+	begin
472	+	FLocalTimeOffset := GetLocalTimeOffset;
473	+	{$if declared(Gettzname)}
474	+	FLocalTimeZoneName := Gettzname(tzdaylight);
475	+	{$else}
476	+	FLocalTimeZoneName := tzname[tzdaylight];
477	+	{$ifend}
478	+	FIsDaylightSavingsTime := tzdaylight;
479	+	if FileExists(DefaultTimeZoneFile) then
480	+	begin
481	+	S := TStringList.Create;
482	+	try
483	+	S.LoadFromFile(DefaultTimeZoneFile);
484	+	if S.Count > 0 then
485	+	FTZDataTimeZoneID := S[0];
486	+	finally
487	+	S.Free;
488	+	end;
489	+	end;
490	+	end;
491	+	{$ENDIF}
492	+
493	+	{$IFDEF WINDOWS}
494	+	procedure TFBClientAPI.GetTZDataSettings;
495	+	var TZInfo: TTimeZoneInformation;
496	+	begin
497	+	FIsDaylightSavingsTime := false;
498	+	{is there any way of working out the default TZData DB time zone ID under Windows?}
499	+	case GetTimeZoneInformation(TZInfo) of
500	+	TIME_ZONE_ID_UNKNOWN:
501	+	begin
502	+	FLocalTimeZoneName := '';
503	+	FLocalTimeOffset := 0;
504	+	end;
505	+	TIME_ZONE_ID_STANDARD:
506	+	begin
507	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.StandardName));
508	+	FLocalTimeOffset := TZInfo.Bias;
509	+	end;
510	+	TIME_ZONE_ID_DAYLIGHT:
511	+	begin
512	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.DaylightName));
513	+	FLocalTimeOffset := TZInfo.DayLightBias;
514	+	FIsDaylightSavingsTime := true;
515	+	end;
516	+	end;
517	+	end;
518	+	{$ENDIF}
519	+
520		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
521		begin
522	<	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
522	>	Result := nil;
523	>	if assigned(FFBLibrary) and (FFBLibrary.IBLibrary <> NilHandle) then
524	>	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
525		if not Assigned(Result) then
526		raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
527		end;
528
529	+	function TFBClientAPI.HasDecFloatSupport: boolean;
530	+	begin
531	+	Result := GetClientMajor >= 4;
532	+	end;
533	+
534	+	function TFBClientAPI.HasInt128Support: boolean;
535	+	begin
536	+	Result := false;
537	+	end;
538	+
539	+	function TFBClientAPI.HasLocalTZDB: boolean;
540	+	begin
541	+	Result := false;
542	+	end;
543	+
544	+	function TFBClientAPI.HasExtendedTZSupport: boolean;
545	+	begin
546	+	Result := false;
547	+	end;
548	+
549	+	function TFBClientAPI.HasTimeZoneSupport: boolean;
550	+	begin
551	+	Result := false;
552	+	end;
553	+
554	+	function TFBClientAPI.GetImplementationVersion: AnsiString;
555	+	begin
556	+	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
557	+	end;
558	+
559		function TFBClientAPI.LoadInterface: boolean;
560		begin
561		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
562		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
380	–	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
563		isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
564		isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
565		isc_free := GetProcAddr('isc_free'); {do not localize}
566	+	isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
567	+	fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
568		Result := assigned(isc_free);
569		end;
570
571	+	procedure TFBClientAPI.FBShutdown;
572	+	begin
573	+	if assigned(fb_shutdown) then
574	+	fb_shutdown(0,fb_shutrsn_exit_called);
575	+	end;
576	+
577		{ TFBStatus }
578
579	<	constructor TFBStatus.Create(aOwner: TFBClientAPI);
579	>	constructor TFBStatus.Create(aOwner: TFBClientAPI; prefix: AnsiString);
580		begin
581		inherited Create;
582		FOwner := aOwner;
583	<	FIBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage];
583	>	FPrefix := prefix;
584	>	FIBDataBaseErrorMessages := [ShowSQLCode, ShowSQLMessage, ShowIBMessage];
585		end;
586
587	<	function TFBStatus.GetIBErrorCode: Long;
587	>	function TFBStatus.GetIBErrorCode: TStatusCode;
588		begin
589		Result := StatusVector^[1];
590		end;
591
592	<	function TFBStatus.Getsqlcode: Long;
592	>	function TFBStatus.Getsqlcode: TStatusCode;
593		begin
594		with FOwner do
595		Result := isc_sqlcode(PISC_STATUS(StatusVector));
#	Line 408 \| Line 599 \| function TFBStatus.GetMessage: AnsiStrin
599		var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
600		IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
601		sqlcode: Long;
411	–	psb: PStatusVector;
602		begin
603	<	Result := '';
603	>	Result := FPrefix;
604		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
605		sqlcode := Getsqlcode;
606		if (ShowSQLCode in IBDataBaseErrorMessages) then
607		Result := Result + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize}
608
419	–	Exclude(IBDataBaseErrorMessages, ShowSQLMessage);
609		if (ShowSQLMessage in IBDataBaseErrorMessages) then
610		begin
611		with FOwner do
612	<	isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength);
612	>	isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
613		if (ShowSQLCode in FIBDataBaseErrorMessages) then
614	<	Result := Result + CRLF;
615	<	Result := Result + strpas(local_buffer);
614	>	Result := Result + LineEnding;
615	>	Result := Result + 'Engine Code: ' + IntToStr(GetIBErrorCode) + ' ' + strpas(local_buffer);
616		end;
617
618		if (ShowIBMessage in IBDataBaseErrorMessages) then
619		begin
620		if (ShowSQLCode in IBDataBaseErrorMessages) or
621		(ShowSQLMessage in IBDataBaseErrorMessages) then
622	<	Result := Result + CRLF;
623	<	psb := StatusVector;
435	<	with FOwner do
436	<	while (isc_interprete(@local_buffer, @psb) > 0) do
437	<	begin
438	<	if (Result <> '') and (Result[Length(Result)] <> LF) then
439	<	Result := Result + CRLF;
440	<	Result := Result + strpas(local_buffer);
441	<	end;
622	>	Result := Result + LineEnding;
623	>	Result := Result + FOwner.FormatStatus(self);
624		end;
625		if (Result <> '') and (Result[Length(Result)] = '.') then
626		Delete(Result, Length(Result), 1);

Diff Legend

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

Comparing ibx/trunk/fbintf/client/FBClientAPI.pas (file contents): Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs. Revision 359 by tony, Tue Dec 7 09:37:32 2021 UTC

Diff Legend

Comparing ibx/trunk/fbintf/client/FBClientAPI.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 2021 UTC