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 315 by tony, Thu Feb 25 11:56:36 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}
82		{$IFDEF DARWIN}
#	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		function FormatStatus(Status: TFBStatus): AnsiString; virtual; abstract;
238
239		{IFirebirdAPI}
#	Line 202 | Line 249 | end;
249		implementation
250
251		uses IBUtils, Registry,
252	<	{$IFDEF Unix} initc, dl, {$ENDIF}
252	>	{$IFDEF Unix} unix, initc, dl, {$ENDIF}
253		{$IFDEF FPC}
254		{$IFDEF WINDOWS }
255		WinDirs,
#	Line 235 | Line 282 | end;
282
283		procedure TFBLibrary.FreeFBLibrary;
284		begin
285	+	(FFirebirdAPI as TFBClientAPI).FBShutdown;
286		if FIBLibrary <> NilHandle then
287		FreeLibrary(FIBLibrary);
288		FIBLibrary := NilHandle;
289	+	FFBLibraryName := '';
290		end;
291
292		function TFBLibrary.GetLibraryName: string;
#	Line 289 | Line 338 | end;
338
339		destructor TFBLibrary.Destroy;
340		begin
292	–	FFirebirdAPI := nil;
341		FreeFBLibrary;
342	+	FFirebirdAPI := nil;
343		inherited Destroy;
344		end;
345
#	Line 301 | Line 350 | begin
350		if aLibPathName <> '' then
351		begin
352		for i := 0 to Length(FLibraryList) - 1 do
353	<	if (FLibraryList[i] as TFBLibrary).FRequestedLibName = aLibPathName then
353	>	begin
354	>	if (FLibraryList[i] as TFBLibrary).SameLibrary(aLibPathName) then
355		begin
356		Result := FLibraryList[i];
357		Exit;
358		end;
359	+	end;
360		Result := Create(aLibPathName);
361		end;
362
#	Line 319 | Line 370 | begin
370		SetLength(FLibraryList,0);
371		end;
372
373	+	function TFBLibrary.SameLibrary(aLibName: string): boolean;
374	+	begin
375	+	Result := FRequestedLibName = aLibName;
376	+	end;
377	+
378		function TFBLibrary.GetHandle: TLibHandle;
379		begin
380		Result := FIBLibrary;
#	Line 330 | Line 386 | constructor TFBClientAPI.Create(aFBLibra
386		begin
387		inherited Create;
388		FFBLibrary := aFBLibrary;
389	+	GetTZDataSettings;
390		end;
391
392		procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 345 | Line 402 | begin
402		raise EIBInterBaseError.Create(GetStatus);
403		end;
404
348	–	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
349	–
405		procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
406		begin
407		while len > 0 do
#	Line 358 | Line 413 | begin
413		end;
414		end;
415
416	+	function TFBClientAPI.Int128ToStr(bufptr: PByte; scale: integer): AnsiString;
417	+	begin
418	+	if not HasInt128Support then
419	+	IBError(ibxeNotSupported,[]);
420	+	end;
421	+
422	+	procedure TFBClientAPI.StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
423	+	begin
424	+	if not HasInt128Support then
425	+	IBError(ibxeNotSupported,[]);
426	+	end;
427	+
428	+	procedure TFBClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
429	+	bufptr: PByte);
430	+	begin
431	+	if not HasDecFloatSupport then
432	+	IBError(ibxeNotSupported,[]);
433	+	end;
434	+
435	+	function TFBClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;
436	+	begin
437	+	if not HasDecFloatSupport then
438	+	IBError(ibxeNotSupported,[]);
439	+	end;
440	+
441		function TFBClientAPI.IsLibraryLoaded: boolean;
442		begin
443		Result := FFBLibrary.IBLibrary <> NilHandle;
#	Line 368 | Line 448 | begin
448		Result := FFBLibrary;
449		end;
450
451	<	function TFBClientAPI.GetImplementationVersion: AnsiString;
451	>	function TFBClientAPI.FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
452		begin
453	<	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
453	>	{aDate/aTime are in TTimestamp format but aTime is decimilliseconds}
454	>	aDate := aDate - DateDelta;
455	>	if aDate < 0 then
456	>	Result := trunc(aDate) - abs(frac(aTime / (MSecsPerDay*10)))
457	>	else
458	>	Result := trunc(aDate) + abs(frac(aTime / (MSecsPerDay*10)));
459		end;
460
461	+	{$IFDEF UNIX}
462	+	procedure TFBClientAPI.GetTZDataSettings;
463	+	var S: TStringList;
464	+	begin
465	+	FLocalTimeOffset := GetLocalTimeOffset;
466	+	FLocalTimeZoneName := strpas(tzname[tzdaylight]);
467	+	FIsDaylightSavingsTime := tzdaylight;
468	+	if FileExists(DefaultTimeZoneFile) then
469	+	begin
470	+	S := TStringList.Create;
471	+	try
472	+	S.LoadFromFile(DefaultTimeZoneFile);
473	+	if S.Count > 0 then
474	+	FTZDataTimeZoneID := S[0];
475	+	finally
476	+	S.Free;
477	+	end;
478	+	end;
479	+	end;
480	+	{$ENDIF}
481	+
482	+	{$IFDEF WINDOWS}
483	+	procedure TFBClientAPI.GetTZDataSettings;
484	+	var TZInfo: TTimeZoneInformation;
485	+	begin
486	+	FIsDaylightSavingsTime := false;
487	+	{is there any way of working out the default TZData DB time zone ID under Windows?}
488	+	case GetTimeZoneInformation(TZInfo) of
489	+	TIME_ZONE_ID_UNKNOWN:
490	+	begin
491	+	FLocalTimeZoneName := '';
492	+	FLocalTimeOffset := 0;
493	+	end;
494	+	TIME_ZONE_ID_STANDARD:
495	+	begin
496	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.StandardName));
497	+	FLocalTimeOffset := TZInfo.Bias;
498	+	end;
499	+	TIME_ZONE_ID_DAYLIGHT:
500	+	begin
501	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.DaylightName));
502	+	FLocalTimeOffset := TZInfo.DayLightBias;
503	+	FIsDaylightSavingsTime := true;
504	+	end;
505	+	end;
506	+	end;
507	+	{$ENDIF}
508	+
509		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
510		begin
511		Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
#	Line 380 | Line 513 | begin
513		raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
514		end;
515
516	+	function TFBClientAPI.HasDecFloatSupport: boolean;
517	+	begin
518	+	Result := GetClientMajor >= 4;
519	+	end;
520	+
521	+	function TFBClientAPI.HasInt128Support: boolean;
522	+	begin
523	+	Result := false;
524	+	end;
525	+
526	+	function TFBClientAPI.HasLocalTZDB: boolean;
527	+	begin
528	+	Result := false;
529	+	end;
530	+
531	+	function TFBClientAPI.HasExtendedTZSupport: boolean;
532	+	begin
533	+	Result := false;
534	+	end;
535	+
536	+	function TFBClientAPI.HasTimeZoneSupport: boolean;
537	+	begin
538	+	Result := false;
539	+	end;
540	+
541	+	function TFBClientAPI.GetImplementationVersion: AnsiString;
542	+	begin
543	+	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
544	+	end;
545	+
546		function TFBClientAPI.LoadInterface: boolean;
547		begin
548		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
#	Line 387 | Line 550 | begin
550		isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
551		isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
552		isc_free := GetProcAddr('isc_free'); {do not localize}
553	+	fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
554		Result := assigned(isc_free);
555		end;
556
557	+	procedure TFBClientAPI.FBShutdown;
558	+	begin
559	+	if assigned(fb_shutdown) then
560	+	fb_shutdown(0,fb_shutrsn_exit_called);
561	+	end;
562	+
563		{ TFBStatus }
564
565		constructor TFBStatus.Create(aOwner: TFBClientAPI);
#	Line 436 | Line 606 | begin
606		if (ShowSQLCode in IBDataBaseErrorMessages) or
607		(ShowSQLMessage in IBDataBaseErrorMessages) then
608		Result := Result + LineEnding;
609	<	Result := Result + LineEnding + FOwner.FormatStatus(self);
609	>	Result := Result + FOwner.FormatStatus(self);
610		end;
611		if (Result <> '') and (Result[Length(Result)] = '.') then
612		Delete(Result, Length(Result), 1);

Diff Legend

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