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 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 2022 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	<	{$IFNDEF FPC}
94	<	type
95	<	TLibHandle = THandle;
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	<	NilHandle = 0;
104	<	DirectorySeparator = '\';
105	<	{$ENDIF}
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;
#	Line 110 | 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;
136		procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
137		end;
138
139	+	{ TFBLibrary }
140	+
141	+	TFBLibrary = class(TFBInterfacedObject,IFirebirdLibrary)
142	+	private
143	+	class var FEnvSetupDone: boolean;
144	+	class var FLibraryList: array of IFirebirdLibrary;
145	+	private
146	+	FFirebirdAPI: IFirebirdAPI;
147	+	FRequestedLibName: string;
148	+	function LoadIBLibrary: boolean;
149	+	protected
150	+	FFBLibraryName: string;
151	+	FIBLibrary: TLibHandle;
152	+	procedure FreeFBLibrary;
153	+	function GetOverrideLibName: string;
154	+	class procedure SetupEnvironment;
155	+	protected
156	+	function GetFirebird3API: IFirebirdAPI; virtual; abstract;
157	+	function GetLegacyFirebirdAPI: IFirebirdAPI; virtual; abstract;
158	+	public
159	+	constructor Create(aLibPathName: string='');
160	+	destructor Destroy; override;
161	+	class function GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
162	+	class procedure FreeLibraries;
163	+	function SameLibrary(aLibName: string): boolean;
164	+
165	+	public
166	+	{IFirebirdLibrary}
167	+	function GetHandle: TLibHandle;
168	+	function GetLibraryName: string;
169	+	function GetLibraryFilePath: string;
170	+	function GetFirebirdAPI: IFirebirdAPI;
171	+	property IBLibrary: TLibHandle read FIBLibrary;
172	+	end;
173	+
174		{ TFBClientAPI }
175
176		TFBClientAPI = class(TFBInterfacedObject)
177		private
178	<	FOwnsIBLibrary: boolean;
178	>	FLocalTimeZoneName: AnsiString; {Informal Time Zone Name from tzname e.g. GMT or BST}
179	>	FTZDataTimeZoneID: AnsiString; {TZData DB ID e.g. Europe/London}
180	>	FLocalTimeOffset: integer;
181	>	FIsDaylightSavingsTime: boolean;
182		class var FIBCS: TRTLCriticalSection;
183	<	procedure LoadIBLibrary;
183	>	function FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
184	>	procedure GetTZDataSettings;
185		protected
186	<	class var FFBLibraryName: string;
137	<	class var IBLibrary: TLibHandle;
138	<	{$IFDEF WINDOWS}
139	<	class var FFBLibraryPath: string;
140	<	{$ENDIF}
186	>	FFBLibrary: TFBLibrary;
187		function GetProcAddr(ProcName: PAnsiChar): Pointer;
188	<	function GetOverrideLibName: string;
189	<	{$IFDEF UNIX}
190	<	function GetFirebirdLibList: string; virtual; abstract;
191	<	{$ENDIF}
192	<	procedure LoadInterface; virtual;
188	>
189	>	protected type
190	>	Tfb_shutdown = function (timeout: uint;
191	>	const reason: int): int;
192	>	{$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
193	>	protected
194	>	{FB Shutdown API}
195	>	fb_shutdown: Tfb_shutdown;
196	>
197		public
198		{Taken from legacy API}
149	–	isc_sqlcode: Tisc_sqlcode;
199		isc_sql_interprete: Tisc_sql_interprete;
200	<	isc_interprete: Tisc_interprete;
152	<	isc_event_counts: Tisc_event_counts;
153	<	isc_event_block: Tisc_event_block;
154	<	isc_free: Tisc_free;
200	>	isc_sqlcode: Tisc_sqlcode;
201
202	<	constructor Create;
157	<	destructor Destroy; override;
202	>	constructor Create(aFBLibrary: TFBLibrary);
203		procedure IBAlloc(var P; OldSize, NewSize: Integer);
204		procedure IBDataBaseError;
205	<	procedure SetupEnvironment;
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;
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	<
230	>	function  SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
231	>	function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; virtual;
232	>	procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
233	>	virtual;
234	>	procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte); virtual;
235	>	function SQLDecFloatDecode(SQLType: cardinal;  bufptr: PByte): tBCD; virtual;
236
237		{IFirebirdAPI}
238		function GetStatus: IStatus; virtual; abstract;
239		function IsLibraryLoaded: boolean;
240		function IsEmbeddedServer: boolean; virtual; abstract;
241	<	function GetLibraryName: string;
242	<	end;
241	>	function GetFBLibrary: IFirebirdLibrary;
242	>	function GetImplementationVersion: AnsiString;
243	>	function GetClientMajor: integer;  virtual; abstract;
244	>	function GetClientMinor: integer;  virtual; abstract;
245	>	end;
246
247	<	var FirebirdClientAPI: TFBClientAPI = nil;
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
257	<	uses IBUtils, Registry, {$IFDEF Unix} initc, {$ENDIF}
257	>	uses IBUtils, Registry,
258	>	{$IFDEF Unix} unix, initc, dl, {$ENDIF}
259		{$IFDEF FPC}
260		{$IFDEF WINDOWS }
261		WinDirs,
#	Line 197 | Line 271 | SysUtils;
271		{$I 'include/wloadlibrary.inc'}
272		{$ENDIF}
273
274	<	{$IFDEF Unix}
275	<	{SetEnvironmentVariable doesn't exist so we have to use C Library}
276	<	function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
277	<	function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
278	<	function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
279	<	// Set environment variable; if empty string given, remove it.
274	>
275	>	{ TFBLibrary }
276	>
277	>	function TFBLibrary.GetOverrideLibName: string;
278	>	begin
279	>	Result := FFBLibraryName;
280	>	if (Result = '') and AllowUseOfFBLIB then
281	>	Result := GetEnvironmentVariable('FBLIB');
282	>	if Result = '' then
283		begin
284	<	result:=false; //assume failure
285	<	if value = '' then
209	<	begin
210	<	// Assume user wants to remove variable.
211	<	if unsetenv(name)=0 then result:=true;
212	<	end
213	<	else
214	<	begin
215	<	// Non empty so set the variable
216	<	if setenv(name, value, 1)=0 then result:=true;
217	<	end;
284	>	if assigned(OnGetLibraryName) then
285	>	OnGetLibraryName(Result)
286		end;
287	<	{$ENDIF}
287	>	end;
288
289	<	{ TFBClientAPI }
289	>	procedure TFBLibrary.FreeFBLibrary;
290	>	begin
291	>	(FFirebirdAPI as TFBClientAPI).FBShutdown;
292	>	if FIBLibrary <> NilHandle then
293	>	FreeLibrary(FIBLibrary);
294	>	FIBLibrary := NilHandle;
295	>	FFBLibraryName := '';
296	>	end;
297	>
298	>	function TFBLibrary.GetLibraryName: string;
299	>	begin
300	>	Result := ExtractFileName(FFBLibraryName);
301	>	end;
302	>
303	>	function TFBLibrary.GetFirebirdAPI: IFirebirdAPI;
304	>	begin
305	>	Result := FFirebirdAPI;
306	>	end;
307
308	<	constructor TFBClientAPI.Create;
308	>	constructor TFBLibrary.Create(aLibPathName: string);
309		begin
310		inherited Create;
311	<	LoadIBLibrary;
312	<	if (IBLibrary <> NilHandle) then
311	>	SetupEnvironment;
312	>	FFBLibraryName := aLibPathName;
313	>	FIBLibrary := NilHandle;
314	>	FFirebirdAPI := GetFirebird3API;
315	>	FRequestedLibName := aLibPathName;
316	>	if aLibPathName <> '' then
317		begin
318	<	SetupEnvironment;
319	<	LoadInterface;
318	>	SetLength(FLibraryList,Length(FLibraryList)+1);
319	>	FLibraryList[Length(FLibraryList)-1] := self;
320		end;
321	<	FirebirdClientAPI := self;
321	>	if FFirebirdAPI <> nil then
322	>	begin
323	>	{First try Firebird 3}
324	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
325	>	FFirebirdAPI := nil;
326	>	end;
327	>
328	>	if FFirebirdAPI = nil then
329	>	begin
330	>	{now try Firebird 2.5. Under Unix we need to reload the library in case we
331	>	are to use the embedded library}
332	>	FFirebirdAPI := GetLegacyFirebirdAPI;
333	>	if FFirebirdAPI <> nil then
334	>	begin
335	>	{$IFDEF UNIX}
336	>	FreeFBLibrary;
337	>	{$ENDIF}
338	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
339	>	FFirebirdAPI := nil;
340	>	end;
341	>	end;
342	>	{Note: FFirebirdAPI will be set to nil if the Firebird API fails to load}
343		end;
344
345	<	destructor TFBClientAPI.Destroy;
345	>	destructor TFBLibrary.Destroy;
346		begin
347	<	FirebirdClientAPI := nil;
348	<	if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
239	<	FreeLibrary(IBLibrary);
240	<	IBLibrary := NilHandle;
347	>	FreeFBLibrary;
348	>	FFirebirdAPI := nil;
349		inherited Destroy;
350		end;
351
352	+	class function TFBLibrary.GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
353	+	var i: integer;
354	+	begin
355	+	Result := nil;
356	+	if aLibPathName <> '' then
357	+	begin
358	+	for i := 0 to Length(FLibraryList) - 1 do
359	+	begin
360	+	if (FLibraryList[i] as TFBLibrary).SameLibrary(aLibPathName) then
361	+	begin
362	+	Result := FLibraryList[i];
363	+	Exit;
364	+	end;
365	+	end;
366	+	Result := Create(aLibPathName);
367	+	end;
368	+
369	+	end;
370	+
371	+	class procedure TFBLibrary.FreeLibraries;
372	+	var i: integer;
373	+	begin
374	+	for i := 0 to Length(FLibraryList) - 1 do
375	+	FLibraryList[i] := nil;
376	+	SetLength(FLibraryList,0);
377	+	end;
378	+
379	+	function TFBLibrary.SameLibrary(aLibName: string): boolean;
380	+	begin
381	+	Result := FRequestedLibName = aLibName;
382	+	end;
383	+
384	+	function TFBLibrary.GetHandle: TLibHandle;
385	+	begin
386	+	Result := FIBLibrary;
387	+	end;
388	+
389	+	{ TFBClientAPI }
390	+
391	+	constructor TFBClientAPI.Create(aFBLibrary: TFBLibrary);
392	+	begin
393	+	inherited Create;
394	+	FFBLibrary := aFBLibrary;
395	+	GetTZDataSettings;
396	+	end;
397	+
398		procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
399		var
400		i: Integer;
#	Line 254 | Line 408 | begin
408		raise EIBInterBaseError.Create(GetStatus);
409		end;
410
411	<	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
258	<
259	<	procedure TFBClientAPI.SetupEnvironment;
260	<	var TmpDir: AnsiString;
261	<	begin
262	<	{$IFDEF UNIX}
263	<	TmpDir := GetTempDir +
264	<	DirectorySeparator + 'firebird_' + sysutils.GetEnvironmentVariable('USER');
265	<	if sysutils.GetEnvironmentVariable('FIREBIRD_TMP') = '' then
266	<	begin
267	<	if not DirectoryExists(tmpDir) then
268	<	mkdir(tmpDir);
269	<	SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir));
270	<	end;
271	<	if sysutils.GetEnvironmentVariable('FIREBIRD_LOCK') = '' then
272	<	begin
273	<	if not DirectoryExists(tmpDir) then
274	<	mkdir(tmpDir);
275	<	SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir));
276	<	end;
277	<	{$ENDIF}
278	<	end;
279	<
280	<	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 288 | 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
465	+	IBError(ibxeNotSupported,[]);
466	+	end;
467	+
468	+	procedure TFBClientAPI.StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte);
469	+	begin
470	+	if not HasInt128Support then
471	+	IBError(ibxeNotSupported,[]);
472	+	end;
473	+
474	+	procedure TFBClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
475	+	bufptr: PByte);
476	+	begin
477	+	if not HasDecFloatSupport then
478	+	IBError(ibxeNotSupported,[]);
479	+	end;
480	+
481	+	function TFBClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;
482	+	begin
483	+	if not HasDecFloatSupport then
484	+	IBError(ibxeNotSupported,[]);
485	+	end;
486	+
487		function TFBClientAPI.IsLibraryLoaded: boolean;
488		begin
489	<	Result := IBLibrary <> NilHandle;
489	>	Result := FFBLibrary.IBLibrary <> NilHandle;
490		end;
491
492	+	function TFBClientAPI.GetFBLibrary: IFirebirdLibrary;
493	+	begin
494	+	Result := FFBLibrary;
495	+	end;
496	+
497	+	function TFBClientAPI.FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
498	+	begin
499	+	{aDate/aTime are in TTimestamp format but aTime is decimilliseconds}
500	+	aDate := aDate - DateDelta;
501	+	if aDate < 0 then
502	+	Result := trunc(aDate) - abs(frac(aTime / (MSecsPerDay*10)))
503	+	else
504	+	Result := trunc(aDate) + abs(frac(aTime / (MSecsPerDay*10)));
505	+	end;
506	+
507	+	{$IFDEF UNIX}
508	+
509	+	procedure TFBClientAPI.GetTZDataSettings;
510	+	var S: TStringList;
511	+	begin
512	+	FLocalTimeOffset := GetLocalTimeOffset;
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
521	+	S := TStringList.Create;
522	+	try
523	+	S.LoadFromFile(DefaultTimeZoneFile);
524	+	if S.Count > 0 then
525	+	FTZDataTimeZoneID := S[0];
526	+	finally
527	+	S.Free;
528	+	end;
529	+	end;
530	+	end;
531	+	{$ENDIF}
532	+
533	+	{$IFDEF WINDOWS}
534	+	procedure TFBClientAPI.GetTZDataSettings;
535	+	var TZInfo: TTimeZoneInformation;
536	+	begin
537	+	FIsDaylightSavingsTime := false;
538	+	{is there any way of working out the default TZData DB time zone ID under Windows?}
539	+	case GetTimeZoneInformation(TZInfo) of
540	+	TIME_ZONE_ID_UNKNOWN:
541	+	begin
542	+	FLocalTimeZoneName := '';
543	+	FLocalTimeOffset := 0;
544	+	end;
545	+	TIME_ZONE_ID_STANDARD:
546	+	begin
547	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.StandardName));
548	+	FLocalTimeOffset := TZInfo.Bias;
549	+	end;
550	+	TIME_ZONE_ID_DAYLIGHT:
551	+	begin
552	+	FLocalTimeZoneName := strpas(PWideChar(@TZInfo.DaylightName));
553	+	FLocalTimeOffset := TZInfo.DayLightBias;
554	+	FIsDaylightSavingsTime := true;
555	+	end;
556	+	end;
557	+	end;
558	+	{$ENDIF}
559	+
560		function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
561		begin
562	<	Result := GetProcAddress(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;
568
569	<	function TFBClientAPI.GetOverrideLibName: string;
569	>	function TFBClientAPI.HasDecFloatSupport: boolean;
570		begin
571	<	Result := '';
572	<	if AllowUseOfFBLIB then
573	<	Result := GetEnvironmentVariable('FBLIB');
574	<	if Result = '' then
575	<	begin
576	<	if assigned(OnGetLibraryName) then
577	<	OnGetLibraryName(Result)
578	<	end;
571	>	Result := GetClientMajor >= 4;
572	>	end;
573	>
574	>	function TFBClientAPI.HasInt128Support: boolean;
575	>	begin
576	>	Result := false;
577	>	end;
578	>
579	>	function TFBClientAPI.HasLocalTZDB: boolean;
580	>	begin
581	>	Result := false;
582	>	end;
583	>
584	>	function TFBClientAPI.HasExtendedTZSupport: boolean;
585	>	begin
586	>	Result := false;
587	>	end;
588	>
589	>	function TFBClientAPI.HasTimeZoneSupport: boolean;
590	>	begin
591	>	Result := false;
592	>	end;
593	>
594	>	function TFBClientAPI.GetImplementationVersion: AnsiString;
595	>	begin
596	>	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
597		end;
598
599	<	procedure TFBClientAPI.LoadInterface;
599	>	function TFBClientAPI.LoadInterface: boolean;
600		begin
601		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
602		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
603	<	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
604	<	isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
321	<	isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
322	<	isc_free := GetProcAddr('isc_free'); {do not localize}
603	>	fb_shutdown := GetProcAddr('fb_shutdown'); {do not localize}
604	>	Result := true; {don't case if these fail to load}
605		end;
606
607	<	function TFBClientAPI.GetLibraryName: string;
607	>	procedure TFBClientAPI.FBShutdown;
608		begin
609	<	Result := FFBLibraryName;
609	>	if assigned(fb_shutdown) then
610	>	fb_shutdown(0,fb_shutrsn_exit_called);
611		end;
612
330	–	const
331	–	IBLocalBufferLength = 512;
332	–	IBBigLocalBufferLength = IBLocalBufferLength * 2;
333	–	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
334	–
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;
357	<	IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
358	<	sqlcode: Long;
359	<	psb: PStatusVector;
648	>	var IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
649		begin
650	<	Result := '';
650	>	Result := FPrefix;
651		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
363	–	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);
368	<	if (ShowSQLMessage in IBDataBaseErrorMessages) then
655	>	if [ShowSQLMessage, ShowIBMessage]*IBDataBaseErrorMessages <> [] then
656		begin
370	–	with FOwner do
371	–	isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength);
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
668	<	(ShowSQLMessage in IBDataBaseErrorMessages) then
669	<	Result := Result + CRLF;
382	<	psb := StatusVector;
383	<	with FOwner do
384	<	while (isc_interprete(@local_buffer, @psb) > 0) do
385	<	begin
386	<	if (Result <> '') and (Result[Length(Result)] <> LF) then
387	<	Result := Result + CRLF;
388	<	Result := Result + strpas(local_buffer);
389	<	end;
667	>	if ShowSQLMessage in IBDataBaseErrorMessages then
668	>	Result := Result + LineEnding;
669	>	Result := Result + GetIBMessage;
670		end;
671		if (Result <> '') and (Result[Length(Result)] = '.') then
672		Delete(Result, Length(Result), 1);
#	Line 444 | Line 724 | begin
724		end;
725
726		initialization
727	<	TFBClientAPI.IBLibrary := NilHandle;
727	>	TFBLibrary.FEnvSetupDone := false;
728		{$IFNDEF FPC}
729		InitializeCriticalSection(TFBClientAPI.FIBCS);
730		{$ELSE}
#	Line 452 | Line 732 | initialization
732		{$ENDIF}
733
734		finalization
735	+	TFBLibrary.FreeLibraries;
736		{$IFNDEF FPC}
737		DeleteCriticalSection(TFBClientAPI.FIBCS);
738		{$ELSE}
739		DoneCriticalSection(TFBClientAPI.FIBCS);
740		{$ENDIF}
460	–	if TFBClientAPI.IBLibrary <> NilHandle then
461	–	begin
462	–	FreeLibrary(TFBClientAPI.IBLibrary);
463	–	TFBClientAPI.IBLibrary := NilHandle;
464	–	TFBClientAPI.FFBLibraryName := '';
465	–	end;
466	–
741		end.
742

Comparing:
ibx/trunk/fbintf/client/FBClientAPI.pas (property svn:eol-style), Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
ibx/branches/udr/client/FBClientAPI.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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