ViewVC Help

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

root/public/ibx/trunk/fbintf/client/FBClientAPI.pas

Comparing ibx/trunk/fbintf/client/FBClientAPI.pas (file contents):
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC vs.
Revision 319 by tony, Thu Feb 25 12:05:40 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 91 | Line 91 | 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;
#	Line 127 | Line 139 | type
139		private
140		class var FEnvSetupDone: boolean;
141		class var FLibraryList: array of IFirebirdLibrary;
142	+	private
143		FFirebirdAPI: IFirebirdAPI;
144		FRequestedLibName: string;
145		function LoadIBLibrary: boolean;
#	Line 144 | Line 157 | type
157		destructor Destroy; override;
158		class function GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
159		class procedure FreeLibraries;
160	+	function SameLibrary(aLibName: string): boolean;
161
162	+	public
163		{IFirebirdLibrary}
164		function GetHandle: TLibHandle;
165		function GetLibraryName: string;
#	Line 157 | Line 172 | type
172
173		TFBClientAPI = class(TFBInterfacedObject)
174		private
175	+	FLocalTimeZoneName: AnsiString; {Informal Time Zone Name from tzname e.g. GMT or BST}
176	+	FTZDataTimeZoneID: AnsiString; {TZData DB ID e.g. Europe/London}
177	+	FLocalTimeOffset: integer;
178	+	FIsDaylightSavingsTime: boolean;
179		class var FIBCS: TRTLCriticalSection;
180	+	function FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
181	+	procedure GetTZDataSettings;
182		protected
183		FFBLibrary: TFBLibrary;
184		function GetProcAddr(ProcName: PAnsiChar): Pointer;
185	+
186	+	protected type
187	+	Tfb_shutdown = function (timeout: uint;
188	+	const reason: int): int;
189	+	{$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
190	+	protected
191	+	{FB Shutdown API}
192	+	fb_shutdown: Tfb_shutdown;
193	+
194		public
195		{Taken from legacy API}
196		isc_sqlcode: Tisc_sqlcode;
#	Line 173 | Line 203 | type
203		procedure IBAlloc(var P; OldSize, NewSize: Integer);
204		procedure IBDataBaseError;
205		function LoadInterface: boolean; virtual;
206	+	procedure FBShutdown; virtual;
207		function GetAPI: IFirebirdAPI; virtual; abstract;
208		{$IFDEF UNIX}
209		function GetFirebirdLibList: string; virtual; abstract;
210		{$ENDIF}
211	+	function HasDecFloatSupport: boolean;
212	+	function HasInt128Support: boolean; virtual;
213	+	function HasLocalTZDB: boolean; virtual;
214	+	function HasExtendedTZSupport: boolean; virtual;
215	+	function HasTimeZoneSupport: boolean; virtual;
216
217	+	public
218	+	property LocalTimeZoneName: AnsiString read FLocalTimeZoneName;
219	+	property TZDataTimeZoneID: AnsiString read FTZDataTimeZoneID;
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;
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;
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;
230	>	function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
231		function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
232	+	function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
233	+	procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
234	+	virtual;
235	+	procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte); virtual;
236	+	function SQLDecFloatDecode(SQLType: cardinal;  bufptr: PByte): tBCD; virtual;
237
238		{IFirebirdAPI}
239		function GetStatus: IStatus; virtual; abstract;
#	Line 202 | Line 248 | end;
248		implementation
249
250		uses IBUtils, Registry,
251	<	{$IFDEF Unix} initc, dl, {$ENDIF}
251	>	{$IFDEF Unix} unix, initc, dl, {$ENDIF}
252		{$IFDEF FPC}
253		{$IFDEF WINDOWS }
254		WinDirs,
#	Line 235 | Line 281 | end;
281
282		procedure TFBLibrary.FreeFBLibrary;
283		begin
284	+	(FFirebirdAPI as TFBClientAPI).FBShutdown;
285		if FIBLibrary <> NilHandle then
286		FreeLibrary(FIBLibrary);
287		FIBLibrary := NilHandle;
288	+	FFBLibraryName := '';
289		end;
290
291		function TFBLibrary.GetLibraryName: string;
#	Line 289 | Line 337 | end;
337
338		destructor TFBLibrary.Destroy;
339		begin
292	–	FFirebirdAPI := nil;
340		FreeFBLibrary;
341	+	FFirebirdAPI := nil;
342		inherited Destroy;
343		end;
344
#	Line 301 | Line 349 | begin
349		if aLibPathName <> '' then
350		begin
351		for i := 0 to Length(FLibraryList) - 1 do
352	<	if (FLibraryList[i] as TFBLibrary).FRequestedLibName = aLibPathName then
352	>	begin
353	>	if (FLibraryList[i] as TFBLibrary).SameLibrary(aLibPathName) then
354		begin
355		Result := FLibraryList[i];
356		Exit;
357		end;
358	+	end;
359		Result := Create(aLibPathName);
360		end;
361
#	Line 319 | Line 369 | begin
369		SetLength(FLibraryList,0);
370		end;
371
372	+	function TFBLibrary.SameLibrary(aLibName: string): boolean;
373	+	begin
374	+	Result := FRequestedLibName = aLibName;
375	+	end;
376	+
377		function TFBLibrary.GetHandle: TLibHandle;
378		begin
379		Result := FIBLibrary;
#	Line 330 | Line 385 | constructor TFBClientAPI.Create(aFBLibra
385		begin
386		inherited Create;
387		FFBLibrary := aFBLibrary;
388	+	GetTZDataSettings;
389		end;
390
391		procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 345 | Line 401 | begin
401		raise EIBInterBaseError.Create(GetStatus);
402		end;
403
348	–	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
349	–
404		procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
405		begin
406		while len > 0 do
#	Line 358 | Line 412 | begin
412		end;
413		end;
414
415	+	function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
416	+	begin
417	+	if not HasInt128Support then
418	+	IBError(ibxeNotSupported,[]);
419	+	end;
420	+
421	+	procedure TFBClientAPI.StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
422	+	begin
423	+	if not HasInt128Support then
424	+	IBError(ibxeNotSupported,[]);
425	+	end;
426	+
427	+	procedure TFBClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
428	+	bufptr: PByte);
429	+	begin
430	+	if not HasDecFloatSupport then
431	+	IBError(ibxeNotSupported,[]);
432	+	end;
433	+
434	+	function TFBClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;
435	+	begin
436	+	if not HasDecFloatSupport then
437	+	IBError(ibxeNotSupported,[]);
438	+	end;
439	+
440		function TFBClientAPI.IsLibraryLoaded: boolean;
441		begin
442		Result := FFBLibrary.IBLibrary <> NilHandle;
#	Line 368 | Line 447 | begin
447		Result := FFBLibrary;
448		end;
449
450	<	function TFBClientAPI.GetImplementationVersion: AnsiString;
450	>	function TFBClientAPI.FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
451		begin
452	<	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
452	>	{aDate/aTime are in TTimestamp format but aTime is decimilliseconds}
453	>	aDate := aDate - DateDelta;
454	>	if aDate < 0 then
455	>	Result := trunc(aDate) - abs(frac(aTime / (MSecsPerDay*10)))
456	>	else
457	>	Result := trunc(aDate) + abs(frac(aTime / (MSecsPerDay*10)));
458	>	end;
459	>
460	>	{$IFDEF UNIX}
461	>	procedure TFBClientAPI.GetTZDataSettings;
462	>	var S: TStringList;
463	>	begin
464	>	FLocalTimeOffset := GetLocalTimeOffset;
465	>	FLocalTimeZoneName := strpas(tzname[tzdaylight]);
466	>	FIsDaylightSavingsTime := tzdaylight;
467	>	if FileExists(DefaultTimeZoneFile) then
468	>	begin
469	>	S := TStringList.Create;
470	>	try
471	>	S.LoadFromFile(DefaultTimeZoneFile);
472	>	if S.Count > 0 then
473	>	FTZDataTimeZoneID := S[0];
474	>	finally
475	>	S.Free;
476	>	end;
477	>	end;
478		end;
479	+	{$ENDIF}
480	+
481	+	{$IFDEF WINDOWS}
482	+	procedure TFBClientAPI.GetTZDataSettings;
483	+	var TZInfo: TTimeZoneInformation;
484	+	begin
485	+	FIsDaylightSavingsTime := false;
486	+	{is there any way of working out the default TZData DB time zone ID under Windows?}
487	+	case GetTimeZoneInformation(TZInfo) of
488	+	TIME_ZONE_ID_UNKNOWN:
489	+	begin
490	+	FLocalTimeZoneName := '';
491	+	FLocalTimeOffset := 0;
492	+	end;
493	+	TIME_ZONE_ID_STANDARD:
494	+	begin
495	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.StandardName));
496	+	FLocalTimeOffset := TZInfo.Bias;
497	+	end;
498	+	TIME_ZONE_ID_DAYLIGHT:
499	+	begin
500	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.DaylightName));
501	+	FLocalTimeOffset := TZInfo.DayLightBias;
502	+	FIsDaylightSavingsTime := true;
503	+	end;
504	+	end;
505	+	end;
506	+	{$ENDIF}
507
508		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
509		begin
#	Line 380 | Line 512 | begin
512		raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
513		end;
514
515	+	function TFBClientAPI.HasDecFloatSupport: boolean;
516	+	begin
517	+	Result := GetClientMajor >= 4;
518	+	end;
519	+
520	+	function TFBClientAPI.HasInt128Support: boolean;
521	+	begin
522	+	Result := false;
523	+	end;
524	+
525	+	function TFBClientAPI.HasLocalTZDB: boolean;
526	+	begin
527	+	Result := false;
528	+	end;
529	+
530	+	function TFBClientAPI.HasExtendedTZSupport: boolean;
531	+	begin
532	+	Result := false;
533	+	end;
534	+
535	+	function TFBClientAPI.HasTimeZoneSupport: boolean;
536	+	begin
537	+	Result := false;
538	+	end;
539	+
540	+	function TFBClientAPI.GetImplementationVersion: AnsiString;
541	+	begin
542	+	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
543	+	end;
544	+
545		function TFBClientAPI.LoadInterface: boolean;
546		begin
547		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
#	Line 387 | Line 549 | begin
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}
552	+	fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
553		Result := assigned(isc_free);
554		end;
555
556	+	procedure TFBClientAPI.FBShutdown;
557	+	begin
558	+	if assigned(fb_shutdown) then
559	+	fb_shutdown(0,fb_shutrsn_exit_called);
560	+	end;
561	+
562		{ TFBStatus }
563
564		constructor TFBStatus.Create(aOwner: TFBClientAPI);
#	Line 436 | Line 605 | begin
605		if (ShowSQLCode in IBDataBaseErrorMessages) or
606		(ShowSQLMessage in IBDataBaseErrorMessages) then
607		Result := Result + LineEnding;
608	<	Result := Result + LineEnding + FOwner.FormatStatus(self);
608	>	Result := Result + FOwner.FormatStatus(self);
609		end;
610		if (Result <> '') and (Result[Length(Result)] = '.') then
611		Delete(Result, Length(Result), 1);

Diff Legend

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