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/journaling/fbintf/client/FBClientAPI.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 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	<	{$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		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;
134		procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
135		end;
136
137	+	{ TFBLibrary }
138	+
139	+	TFBLibrary = class(TFBInterfacedObject,IFirebirdLibrary)
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;
147	+	protected
148	+	FFBLibraryName: string;
149	+	FIBLibrary: TLibHandle;
150	+	procedure FreeFBLibrary;
151	+	function GetOverrideLibName: string;
152	+	class procedure SetupEnvironment;
153	+	protected
154	+	function GetFirebird3API: IFirebirdAPI; virtual; abstract;
155	+	function GetLegacyFirebirdAPI: IFirebirdAPI; virtual; abstract;
156	+	public
157	+	constructor Create(aLibPathName: string='');
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;
167	+	function GetLibraryFilePath: string;
168	+	function GetFirebirdAPI: IFirebirdAPI;
169	+	property IBLibrary: TLibHandle read FIBLibrary;
170	+	end;
171	+
172		{ TFBClientAPI }
173
174		TFBClientAPI = class(TFBInterfacedObject)
175		private
176	<	FOwnsIBLibrary: boolean;
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	<	procedure LoadIBLibrary;
181	>	function FBTimeStampToDateTime(aDate, aTime: longint): TDateTime;
182	>	procedure GetTZDataSettings;
183		protected
184	<	class var FFBLibraryName: string;
137	<	class var IBLibrary: TLibHandle;
138	<	{$IFDEF WINDOWS}
139	<	class var FFBLibraryPath: string;
140	<	{$ENDIF}
184	>	FFBLibrary: TFBLibrary;
185		function GetProcAddr(ProcName: PAnsiChar): Pointer;
186	<	function GetOverrideLibName: string;
187	<	{$IFDEF UNIX}
188	<	function GetFirebirdLibList: string; virtual; abstract;
189	<	{$ENDIF}
190	<	procedure LoadInterface; virtual;
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;
151	–	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;
157	<	destructor Destroy; override;
204	>	constructor Create(aFBLibrary: TFBLibrary);
205		procedure IBAlloc(var P; OldSize, NewSize: Integer);
206		procedure IBDataBaseError;
207	<	procedure SetupEnvironment;
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 GetLibraryName: string;
244	>	function GetFBLibrary: IFirebirdLibrary;
245	>	function GetImplementationVersion: AnsiString;
246	>	function GetClientMajor: integer;  virtual; abstract;
247	>	function GetClientMinor: integer;  virtual; abstract;
248		end;
249
180	–	var FirebirdClientAPI: TFBClientAPI = nil;
181	–
250		implementation
251
252	<	uses IBUtils, Registry, {$IFDEF Unix} initc, {$ENDIF}
252	>	uses IBUtils, Registry,
253	>	{$IFDEF Unix} unix, initc, dl, {$ENDIF}
254		{$IFDEF FPC}
255		{$IFDEF WINDOWS }
256		WinDirs,
#	Line 197 | Line 266 | SysUtils;
266		{$I 'include/wloadlibrary.inc'}
267		{$ENDIF}
268
269	<	{$IFDEF Unix}
270	<	{SetEnvironmentVariable doesn't exist so we have to use C Library}
271	<	function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
272	<	function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
273	<	function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
274	<	// Set environment variable; if empty string given, remove it.
269	>
270	>	{ TFBLibrary }
271	>
272	>	function TFBLibrary.GetOverrideLibName: string;
273	>	begin
274	>	Result := FFBLibraryName;
275	>	if (Result = '') and AllowUseOfFBLIB then
276	>	Result := GetEnvironmentVariable('FBLIB');
277	>	if Result = '' then
278	>	begin
279	>	if assigned(OnGetLibraryName) then
280	>	OnGetLibraryName(Result)
281	>	end;
282	>	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;
294	>	begin
295	>	Result := ExtractFileName(FFBLibraryName);
296	>	end;
297	>
298	>	function TFBLibrary.GetFirebirdAPI: IFirebirdAPI;
299	>	begin
300	>	Result := FFirebirdAPI;
301	>	end;
302	>
303	>	constructor TFBLibrary.Create(aLibPathName: string);
304	>	begin
305	>	inherited Create;
306	>	SetupEnvironment;
307	>	FFBLibraryName := aLibPathName;
308	>	FIBLibrary := NilHandle;
309	>	FFirebirdAPI := GetFirebird3API;
310	>	FRequestedLibName := aLibPathName;
311	>	if aLibPathName <> '' then
312		begin
313	<	result:=false; //assume failure
314	<	if value = '' then
315	<	begin
316	<	// Assume user wants to remove variable.
317	<	if unsetenv(name)=0 then result:=true;
318	<	end
319	<	else
313	>	SetLength(FLibraryList,Length(FLibraryList)+1);
314	>	FLibraryList[Length(FLibraryList)-1] := self;
315	>	end;
316	>	if FFirebirdAPI <> nil then
317	>	begin
318	>	{First try Firebird 3}
319	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
320	>	FFirebirdAPI := nil;
321	>	end;
322	>
323	>	if FFirebirdAPI = nil then
324	>	begin
325	>	{now try Firebird 2.5. Under Unix we need to reload the library in case we
326	>	are to use the embedded library}
327	>	FFirebirdAPI := GetLegacyFirebirdAPI;
328	>	if FFirebirdAPI <> nil then
329		begin
330	<	// Non empty so set the variable
331	<	if setenv(name, value, 1)=0 then result:=true;
330	>	{$IFDEF UNIX}
331	>	FreeFBLibrary;
332	>	{$ENDIF}
333	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
334	>	FFirebirdAPI := nil;
335		end;
336		end;
337	<	{$ENDIF}
337	>	{Note: FFirebirdAPI will be set to nil if the Firebird API fails to load}
338	>	end;
339
340	<	{ TFBClientAPI }
340	>	destructor TFBLibrary.Destroy;
341	>	begin
342	>	FreeFBLibrary;
343	>	FFirebirdAPI := nil;
344	>	inherited Destroy;
345	>	end;
346
347	<	constructor TFBClientAPI.Create;
347	>	class function TFBLibrary.GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
348	>	var i: integer;
349		begin
350	<	inherited Create;
351	<	LoadIBLibrary;
227	<	if (IBLibrary <> NilHandle) then
350	>	Result := nil;
351	>	if aLibPathName <> '' then
352		begin
353	<	SetupEnvironment;
354	<	LoadInterface;
353	>	for i := 0 to Length(FLibraryList) - 1 do
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	<	FirebirdClientAPI := self;
363	>
364		end;
365
366	<	destructor TFBClientAPI.Destroy;
366	>	class procedure TFBLibrary.FreeLibraries;
367	>	var i: integer;
368		begin
369	<	FirebirdClientAPI := nil;
370	<	if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
371	<	FreeLibrary(IBLibrary);
372	<	IBLibrary := NilHandle;
373	<	inherited Destroy;
369	>	for i := 0 to Length(FLibraryList) - 1 do
370	>	FLibraryList[i] := nil;
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;
382	>	end;
383	>
384	>	{ TFBClientAPI }
385	>
386	>	constructor TFBClientAPI.Create(aFBLibrary: TFBLibrary);
387	>	begin
388	>	inherited Create;
389	>	FFBLibrary := aFBLibrary;
390	>	GetTZDataSettings;
391		end;
392
393		procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
#	Line 254 | Line 403 | begin
403		raise EIBInterBaseError.Create(GetStatus);
404		end;
405
257	–	{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	–
406		procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
407		begin
408		while len > 0 do
#	Line 288 | 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 := IBLibrary <> NilHandle;
449	>	Result := FFBLibrary.IBLibrary <> NilHandle;
450	>	end;
451	>
452	>	function TFBClientAPI.GetFBLibrary: IFirebirdLibrary;
453	>	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(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.GetOverrideLibName: string;
529	>	function TFBClientAPI.HasDecFloatSupport: boolean;
530		begin
531	<	Result := '';
532	<	if AllowUseOfFBLIB then
533	<	Result := GetEnvironmentVariable('FBLIB');
534	<	if Result = '' then
535	<	begin
536	<	if assigned(OnGetLibraryName) then
537	<	OnGetLibraryName(Result)
538	<	end;
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	<	procedure TFBClientAPI.LoadInterface;
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}
319	–	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	<	function TFBClientAPI.GetLibraryName: string;
571	>	procedure TFBClientAPI.FBShutdown;
572		begin
573	<	Result := FFBLibraryName;
573	>	if assigned(fb_shutdown) then
574	>	fb_shutdown(0,fb_shutrsn_exit_called);
575		end;
576
330	–	const
331	–	IBLocalBufferLength = 512;
332	–	IBBigLocalBufferLength = IBLocalBufferLength * 2;
333	–	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
334	–
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 356 | Line 599 | function TFBStatus.GetMessage: AnsiStrin
599		var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
600		IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
601		sqlcode: Long;
359	–	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
367	–	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;
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;
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);
#	Line 444 | Line 678 | begin
678		end;
679
680		initialization
681	<	TFBClientAPI.IBLibrary := NilHandle;
681	>	TFBLibrary.FEnvSetupDone := false;
682		{$IFNDEF FPC}
683		InitializeCriticalSection(TFBClientAPI.FIBCS);
684		{$ELSE}
#	Line 452 | Line 686 | initialization
686		{$ENDIF}
687
688		finalization
689	+	TFBLibrary.FreeLibraries;
690		{$IFNDEF FPC}
691		DeleteCriticalSection(TFBClientAPI.FIBCS);
692		{$ELSE}
693		DoneCriticalSection(TFBClientAPI.FIBCS);
694		{$ENDIF}
460	–	if TFBClientAPI.IBLibrary <> NilHandle then
461	–	begin
462	–	FreeLibrary(TFBClientAPI.IBLibrary);
463	–	TFBClientAPI.IBLibrary := NilHandle;
464	–	TFBClientAPI.FFBLibraryName := '';
465	–	end;
466	–
695		end.
696

Diff Legend

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