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 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 316 by tony, Thu Feb 25 11:59:00 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 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 122 | 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 139 | 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 152 | 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;
197		isc_sql_interprete: Tisc_sql_interprete;
163	–	isc_interprete: Tisc_interprete;
198		isc_event_counts: Tisc_event_counts;
199		isc_event_block: Tisc_event_block;
200		isc_free: Tisc_free;
#	Line 169 | 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;
231	<
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;
240		function IsLibraryLoaded: boolean;
241		function IsEmbeddedServer: boolean; virtual; abstract;
242		function GetFBLibrary: IFirebirdLibrary;
243	+	function GetImplementationVersion: AnsiString;
244	+	function GetClientMajor: integer;  virtual; abstract;
245	+	function GetClientMinor: integer;  virtual; abstract;
246		end;
247
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 205 | Line 258 | WinDirs,
258		{$ENDIF}
259		SysUtils;
260
208	–	const
209	–	IBLocalBufferLength = 512;
210	–	IBBigLocalBufferLength = IBLocalBufferLength * 2;
211	–	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
212	–
261		{$IFDEF UNIX}
262		{$I 'include/uloadlibrary.inc'}
263		{$ELSE}
#	Line 233 | 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 287 | Line 337 | end;
337
338		destructor TFBLibrary.Destroy;
339		begin
290	–	FFirebirdAPI := nil;
340		FreeFBLibrary;
341	+	FFirebirdAPI := nil;
342		inherited Destroy;
343		end;
344
#	Line 299 | 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 317 | 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 328 | 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 343 | Line 401 | begin
401		raise EIBInterBaseError.Create(GetStatus);
402		end;
403
346	–	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
347	–
404		procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
405		begin
406		while len > 0 do
#	Line 356 | 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 366 | Line 447 | begin
447		Result := FFBLibrary;
448		end;
449
450	+	function TFBClientAPI.FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
451	+	begin
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
510		Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
#	Line 373 | 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}
548		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
380	–	isc_interprete := GetProcAddr('isc_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}
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 408 | Line 583 | function TFBStatus.GetMessage: AnsiStrin
583		var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
584		IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
585		sqlcode: Long;
411	–	psb: PStatusVector;
586		begin
587		Result := '';
588		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
#	Line 420 | Line 594 | begin
594		if (ShowSQLMessage in IBDataBaseErrorMessages) then
595		begin
596		with FOwner do
597	<	isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength);
597	>	isc_sql_interprete(sqlcode, local_buffer, sizeof(local_buffer));
598		if (ShowSQLCode in FIBDataBaseErrorMessages) then
599		Result := Result + CRLF;
600		Result := Result + strpas(local_buffer);
#	Line 430 | Line 604 | begin
604		begin
605		if (ShowSQLCode in IBDataBaseErrorMessages) or
606		(ShowSQLMessage in IBDataBaseErrorMessages) then
607	<	Result := Result + CRLF;
608	<	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;
607	>	Result := Result + LineEnding;
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