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 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

#	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;
96	–
97	–	const
98	–	NilHandle = 0;
99	–	DirectorySeparator = '\';
100	–	{$ENDIF}
101	–
93		type
94		TStatusVector              = array[0..19] of NativeInt;
95		PStatusVector              = ^TStatusVector;
#	Line 125 | Line 116 | type
116		procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
117		end;
118
119	+	{ TFBLibrary }
120	+
121	+	TFBLibrary = class(TFBInterfacedObject,IFirebirdLibrary)
122	+	private
123	+	class var FEnvSetupDone: boolean;
124	+	class var FLibraryList: array of IFirebirdLibrary;
125	+	FFirebirdAPI: IFirebirdAPI;
126	+	FRequestedLibName: string;
127	+	function LoadIBLibrary: boolean;
128	+	protected
129	+	FFBLibraryName: string;
130	+	FIBLibrary: TLibHandle;
131	+	procedure FreeFBLibrary;
132	+	function GetOverrideLibName: string;
133	+	class procedure SetupEnvironment;
134	+	protected
135	+	function GetFirebird3API: IFirebirdAPI; virtual; abstract;
136	+	function GetLegacyFirebirdAPI: IFirebirdAPI; virtual; abstract;
137	+	public
138	+	constructor Create(aLibPathName: string='');
139	+	destructor Destroy; override;
140	+	class function GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
141	+	class procedure FreeLibraries;
142	+
143	+	{IFirebirdLibrary}
144	+	function GetHandle: TLibHandle;
145	+	function GetLibraryName: string;
146	+	function GetLibraryFilePath: string;
147	+	function GetFirebirdAPI: IFirebirdAPI;
148	+	property IBLibrary: TLibHandle read FIBLibrary;
149	+	end;
150	+
151		{ TFBClientAPI }
152
153		TFBClientAPI = class(TFBInterfacedObject)
154		private
132	–	FOwnsIBLibrary: boolean;
155		class var FIBCS: TRTLCriticalSection;
134	–	procedure LoadIBLibrary;
156		protected
157	<	class var FFBLibraryName: string;
137	<	class var IBLibrary: TLibHandle;
138	<	{$IFDEF WINDOWS}
139	<	class var FFBLibraryPath: string;
140	<	{$ENDIF}
157	>	FFBLibrary: TFBLibrary;
158		function GetProcAddr(ProcName: PAnsiChar): Pointer;
142	–	function GetOverrideLibName: string;
143	–	{$IFDEF UNIX}
144	–	function GetFirebirdLibList: string; virtual; abstract;
145	–	{$ENDIF}
146	–	procedure LoadInterface; virtual;
159		public
160		{Taken from legacy API}
161		isc_sqlcode: Tisc_sqlcode;
#	Line 153 | Line 165 | type
165		isc_event_block: Tisc_event_block;
166		isc_free: Tisc_free;
167
168	<	constructor Create;
157	<	destructor Destroy; override;
168	>	constructor Create(aFBLibrary: TFBLibrary);
169		procedure IBAlloc(var P; OldSize, NewSize: Integer);
170		procedure IBDataBaseError;
171	<	procedure SetupEnvironment;
171	>	function LoadInterface: boolean; virtual;
172	>	function GetAPI: IFirebirdAPI; virtual; abstract;
173	>	{$IFDEF UNIX}
174	>	function GetFirebirdLibList: string; virtual; abstract;
175	>	{$ENDIF}
176
177		{Encode/Decode}
178		procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
#	Line 174 | Line 189 | type
189		function GetStatus: IStatus; virtual; abstract;
190		function IsLibraryLoaded: boolean;
191		function IsEmbeddedServer: boolean; virtual; abstract;
192	<	function GetLibraryName: string;
192	>	function GetFBLibrary: IFirebirdLibrary;
193		end;
194
180	–	var FirebirdClientAPI: TFBClientAPI = nil;
181	–
195		implementation
196
197	<	uses IBUtils, Registry, {$IFDEF Unix} initc, {$ENDIF}
197	>	uses IBUtils, Registry,
198	>	{$IFDEF Unix} initc, dl, {$ENDIF}
199		{$IFDEF FPC}
200		{$IFDEF WINDOWS }
201		WinDirs,
#	Line 191 | Line 205 | WinDirs,
205		{$ENDIF}
206		SysUtils;
207
208	+	const
209	+	IBLocalBufferLength = 512;
210	+	IBBigLocalBufferLength = IBLocalBufferLength * 2;
211	+	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
212	+
213		{$IFDEF UNIX}
214		{$I 'include/uloadlibrary.inc'}
215		{$ELSE}
216		{$I 'include/wloadlibrary.inc'}
217		{$ENDIF}
218
219	<	{$IFDEF Unix}
220	<	{SetEnvironmentVariable doesn't exist so we have to use C Library}
221	<	function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
222	<	function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
223	<	function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
224	<	// Set environment variable; if empty string given, remove it.
219	>
220	>	{ TFBLibrary }
221	>
222	>	function TFBLibrary.GetOverrideLibName: string;
223	>	begin
224	>	Result := FFBLibraryName;
225	>	if (Result = '') and AllowUseOfFBLIB then
226	>	Result := GetEnvironmentVariable('FBLIB');
227	>	if Result = '' then
228		begin
229	<	result:=false; //assume failure
230	<	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;
229	>	if assigned(OnGetLibraryName) then
230	>	OnGetLibraryName(Result)
231		end;
232	<	{$ENDIF}
232	>	end;
233
234	<	{ TFBClientAPI }
234	>	procedure TFBLibrary.FreeFBLibrary;
235	>	begin
236	>	if FIBLibrary <> NilHandle then
237	>	FreeLibrary(FIBLibrary);
238	>	FIBLibrary := NilHandle;
239	>	end;
240	>
241	>	function TFBLibrary.GetLibraryName: string;
242	>	begin
243	>	Result := ExtractFileName(FFBLibraryName);
244	>	end;
245	>
246	>	function TFBLibrary.GetFirebirdAPI: IFirebirdAPI;
247	>	begin
248	>	Result := FFirebirdAPI;
249	>	end;
250
251	<	constructor TFBClientAPI.Create;
251	>	constructor TFBLibrary.Create(aLibPathName: string);
252		begin
253		inherited Create;
254	<	LoadIBLibrary;
255	<	if (IBLibrary <> NilHandle) then
254	>	SetupEnvironment;
255	>	FFBLibraryName := aLibPathName;
256	>	FIBLibrary := NilHandle;
257	>	FFirebirdAPI := GetFirebird3API;
258	>	FRequestedLibName := aLibPathName;
259	>	if aLibPathName <> '' then
260	>	begin
261	>	SetLength(FLibraryList,Length(FLibraryList)+1);
262	>	FLibraryList[Length(FLibraryList)-1] := self;
263	>	end;
264	>	if FFirebirdAPI <> nil then
265	>	begin
266	>	{First try Firebird 3}
267	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
268	>	FFirebirdAPI := nil;
269	>	end;
270	>
271	>	if FFirebirdAPI = nil then
272		begin
273	<	SetupEnvironment;
274	<	LoadInterface;
273	>	{now try Firebird 2.5. Under Unix we need to reload the library in case we
274	>	are to use the embedded library}
275	>	FFirebirdAPI := GetLegacyFirebirdAPI;
276	>	if FFirebirdAPI <> nil then
277	>	begin
278	>	{$IFDEF UNIX}
279	>	FreeFBLibrary;
280	>	{$ENDIF}
281	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
282	>	FFirebirdAPI := nil;
283	>	end;
284		end;
285	<	FirebirdClientAPI := self;
285	>	{Note: FFirebirdAPI will be set to nil if the Firebird API fails to load}
286		end;
287
288	<	destructor TFBClientAPI.Destroy;
288	>	destructor TFBLibrary.Destroy;
289		begin
290	<	FirebirdClientAPI := nil;
291	<	if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
239	<	FreeLibrary(IBLibrary);
240	<	IBLibrary := NilHandle;
290	>	FFirebirdAPI := nil;
291	>	FreeFBLibrary;
292		inherited Destroy;
293		end;
294
295	+	class function TFBLibrary.GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
296	+	var i: integer;
297	+	begin
298	+	Result := nil;
299	+	if aLibPathName <> '' then
300	+	begin
301	+	for i := 0 to Length(FLibraryList) - 1 do
302	+	if (FLibraryList[i] as TFBLibrary).FRequestedLibName = aLibPathName then
303	+	begin
304	+	Result := FLibraryList[i];
305	+	Exit;
306	+	end;
307	+	Result := Create(aLibPathName);
308	+	end;
309	+
310	+	end;
311	+
312	+	class procedure TFBLibrary.FreeLibraries;
313	+	var i: integer;
314	+	begin
315	+	for i := 0 to Length(FLibraryList) - 1 do
316	+	FLibraryList[i] := nil;
317	+	SetLength(FLibraryList,0);
318	+	end;
319	+
320	+	function TFBLibrary.GetHandle: TLibHandle;
321	+	begin
322	+	Result := FIBLibrary;
323	+	end;
324	+
325	+	{ TFBClientAPI }
326	+
327	+	constructor TFBClientAPI.Create(aFBLibrary: TFBLibrary);
328	+	begin
329	+	inherited Create;
330	+	FFBLibrary := aFBLibrary;
331	+	end;
332	+
333		procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
334		var
335		i: Integer;
#	Line 256 | Line 345 | end;
345
346		{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
347
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	–
348		procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
349		begin
350		while len > 0 do
#	Line 290 | Line 358 | end;
358
359		function TFBClientAPI.IsLibraryLoaded: boolean;
360		begin
361	<	Result := IBLibrary <> NilHandle;
361	>	Result := FFBLibrary.IBLibrary <> NilHandle;
362		end;
363
364	<	function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
364	>	function TFBClientAPI.GetFBLibrary: IFirebirdLibrary;
365		begin
366	<	Result := GetProcAddress(IBLibrary, ProcName);
299	<	if not Assigned(Result) then
300	<	raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
366	>	Result := FFBLibrary;
367		end;
368
369	<	function TFBClientAPI.GetOverrideLibName: string;
369	>	function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
370		begin
371	<	Result := '';
372	<	if AllowUseOfFBLIB then
373	<	Result := GetEnvironmentVariable('FBLIB');
308	<	if Result = '' then
309	<	begin
310	<	if assigned(OnGetLibraryName) then
311	<	OnGetLibraryName(Result)
312	<	end;
371	>	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
372	>	if not Assigned(Result) then
373	>	raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
374		end;
375
376	<	procedure TFBClientAPI.LoadInterface;
376	>	function TFBClientAPI.LoadInterface: boolean;
377		begin
378		isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
379		isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
#	Line 320 | Line 381 | begin
381		isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
382		isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
383		isc_free := GetProcAddr('isc_free'); {do not localize}
384	+	Result := assigned(isc_free);
385		end;
386
325	–	function TFBClientAPI.GetLibraryName: string;
326	–	begin
327	–	Result := FFBLibraryName;
328	–	end;
329	–
330	–	const
331	–	IBLocalBufferLength = 512;
332	–	IBBigLocalBufferLength = IBLocalBufferLength * 2;
333	–	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
334	–
387		{ TFBStatus }
388
389		constructor TFBStatus.Create(aOwner: TFBClientAPI);
#	Line 444 | Line 496 | begin
496		end;
497
498		initialization
499	<	TFBClientAPI.IBLibrary := NilHandle;
499	>	TFBLibrary.FEnvSetupDone := false;
500		{$IFNDEF FPC}
501		InitializeCriticalSection(TFBClientAPI.FIBCS);
502		{$ELSE}
#	Line 452 | Line 504 | initialization
504		{$ENDIF}
505
506		finalization
507	+	TFBLibrary.FreeLibraries;
508		{$IFNDEF FPC}
509		DeleteCriticalSection(TFBClientAPI.FIBCS);
510		{$ELSE}
511		DoneCriticalSection(TFBClientAPI.FIBCS);
512		{$ENDIF}
460	–	if TFBClientAPI.IBLibrary <> NilHandle then
461	–	begin
462	–	FreeLibrary(TFBClientAPI.IBLibrary);
463	–	TFBClientAPI.IBLibrary := NilHandle;
464	–	TFBClientAPI.FFBLibraryName := '';
465	–	end;
466	–
513		end.
514

Diff Legend

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