ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

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

Diff Legend

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