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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC

#	Line 60 | Line 60
60		{                                                                        }
61		{************************************************************************}
62		unit FBClientAPI;
63	+	{$IFDEF MSWINDOWS}
64	+	{$DEFINE WINDOWS}
65	+	{$ENDIF}
66
67		{$IFDEF FPC}
68		{$mode delphi}
#	Line 70 | Line 73 | unit FBClientAPI;
73		interface
74
75		uses
76	<	Classes,  Dynlibs, IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals;
76	>	Classes,
77	>	{$IFDEF WINDOWS}Windows, {$ENDIF}
78	>	{$IFDEF FPC} Dynlibs, {$ENDIF}
79	>	IB, IBHeader, FBActivityMonitor, FBMessages, IBExternals;
80
81		{For Linux see result of GetFirebirdLibList method}
82		{$IFDEF DARWIN}
#	Line 84 | Line 90 | FIREBIRD_CLIENT = 'fbclient.dll'; {do no
90		FIREBIRD_EMBEDDED = 'fbembed.dll';
91		{$ENDIF}
92
93	+	const
94	+	IBLocalBufferLength = 512;
95	+	IBBigLocalBufferLength = IBLocalBufferLength * 2;
96	+	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
97	+
98		type
99		TStatusVector              = array[0..19] of NativeInt;
100		PStatusVector              = ^TStatusVector;
#	Line 94 | Line 105 | type
105
106		TFBStatus = class(TFBInterfacedObject)
107		private
97	–	FIBCS: TRTLCriticalSection; static;
108		FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
109		protected
110		FOwner: TFBClientAPI;
#	Line 105 | Line 115 | type
115		{IStatus}
116		function GetIBErrorCode: Long;
117		function Getsqlcode: Long;
118	<	function GetMessage: string;
118	>	function GetMessage: AnsiString;
119		function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
120		function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
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
160	<	FOwnsIBLibrary: boolean;
119	<	procedure LoadIBLibrary;
160	>	class var FIBCS: TRTLCriticalSection;
161		protected
162	<	FFBLibraryName: string; static;
163	<	FFBLibraryPath: string; static;
123	<	IBLibrary: TLibHandle; static;
124	<	function GetProcAddr(ProcName: PChar): Pointer;
125	<	function GetOverrideLibName: string;
126	<	{$IFDEF UNIX}
127	<	function GetFirebirdLibList: string; virtual; abstract;
128	<	{$ENDIF}
129	<	procedure LoadInterface; virtual;
162	>	FFBLibrary: TFBLibrary;
163	>	function GetProcAddr(ProcName: PAnsiChar): Pointer;
164		public
165		{Taken from legacy API}
166		isc_sqlcode: Tisc_sqlcode;
167		isc_sql_interprete: Tisc_sql_interprete;
134	–	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;
140	<	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: PChar);
183	<	function DecodeInteger(bufptr: PChar; len: short): integer; virtual; abstract;
184	<	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); virtual; abstract;
185	<	function SQLDecodeDate(byfptr: PChar): TDateTime; virtual; abstract;
186	<	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); virtual; abstract;
187	<	function SQLDecodeTime(bufptr: PChar): TDateTime;  virtual; abstract;
188	<	procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); virtual; abstract;
189	<	function SQLDecodeDateTime(bufptr: PChar): TDateTime; virtual; abstract;
190	<
182	>	procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
183	>	function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
184	>	procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
185	>	function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
186	>	procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
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	>	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;
197	<	function GetCharsetName(CharSetID: integer): string;
198	<	function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
199	<	function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
200	<	function CharSetName2CharSetID(CharSetName: string; var CharSetID: integer): boolean;
165	<	function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
166	<	end;
167	<
168	<	const FirebirdClientAPI: TFBClientAPI = nil;
196	>	function GetFBLibrary: IFirebirdLibrary;
197	>	function GetImplementationVersion: AnsiString;
198	>	function GetClientMajor: integer;  virtual; abstract;
199	>	function GetClientMinor: integer;  virtual; abstract;
200	>	end;
201
202		implementation
203
204	<	uses IBUtils, {$IFDEF Unix} initc, {$ENDIF}
204	>	uses IBUtils, Registry,
205	>	{$IFDEF Unix} initc, dl, {$ENDIF}
206	>	{$IFDEF FPC}
207		{$IFDEF WINDOWS }
208	<	Windows,Registry, WinDirs,
208	>	WinDirs,
209	>	{$ENDIF}
210	>	{$ELSE}
211	>	ShlObj,
212		{$ENDIF}
213		SysUtils;
214
215		{$IFDEF UNIX}
216	<	{$I uloadlibrary.inc}
216	>	{$I 'include/uloadlibrary.inc'}
217		{$ELSE}
218	<	{$I wloadlibrary.inc}
218	>	{$I 'include/wloadlibrary.inc'}
219		{$ENDIF}
220
184	–	type
185	–	TCharsetMap = record
186	–	CharsetID: integer;
187	–	CharSetName: string;
188	–	CharSetWidth: integer;
189	–	CodePage: TSystemCodePage;
190	–	end;
221
222	<	const
193	<	CharSetMap: array [0..69] of TCharsetMap = (
194	<	(CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_NONE),
195	<	(CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE),
196	<	(CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: CP_ASCII),
197	<	(CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8),
198	<	(CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8),
199	<	(CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932),
200	<	(CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932),
201	<	(CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
202	<	(CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
203	<	(CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737),
204	<	(CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437),
205	<	(CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850),
206	<	(CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865),
207	<	(CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860),
208	<	(CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863),
209	<	(CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775),
210	<	(CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858),
211	<	(CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862),
212	<	(CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864),
213	<	(CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE),
214	<	(CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
215	<	(CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591),
216	<	(CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592),
217	<	(CharsetID: 23; CharSetName: 'ISO8859_3'; CharSetWidth: 1; CodePage: 28593),
218	<	(CharsetID: 24; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
219	<	(CharsetID: 25; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
220	<	(CharsetID: 26; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
221	<	(CharsetID: 27; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
222	<	(CharsetID: 28; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
223	<	(CharsetID: 29; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
224	<	(CharsetID: 30; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
225	<	(CharsetID: 31; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
226	<	(CharsetID: 32; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
227	<	(CharsetID: 33; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
228	<	(CharsetID: 34; CharSetName: 'ISO8859_4'; CharSetWidth: 1; CodePage: 28594),
229	<	(CharsetID: 35; CharSetName: 'ISO8859_5'; CharSetWidth: 1; CodePage: 28595),
230	<	(CharsetID: 36; CharSetName: 'ISO8859_6'; CharSetWidth: 1; CodePage: 28596),
231	<	(CharsetID: 37; CharSetName: 'ISO8859_7'; CharSetWidth: 1; CodePage: 28597),
232	<	(CharsetID: 38; CharSetName: 'ISO8859_8'; CharSetWidth: 1; CodePage: 28598),
233	<	(CharsetID: 39; CharSetName: 'ISO8859_9'; CharSetWidth: 1; CodePage: 28599),
234	<	(CharsetID: 40; CharSetName: 'ISO8859_13'; CharSetWidth: 1; CodePage: 28603),
235	<	(CharsetID: 41; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
236	<	(CharsetID: 42; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
237	<	(CharsetID: 43; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
238	<	(CharsetID: 44; CharSetName: 'KSC_5601'; CharSetWidth: 2; CodePage: 949),
239	<	(CharsetID: 45; CharSetName: 'DOS852'; CharSetWidth: 1; CodePage: 852),
240	<	(CharsetID: 46; CharSetName: 'DOS857'; CharSetWidth: 1; CodePage: 857),
241	<	(CharsetID: 47; CharSetName: 'DOS861'; CharSetWidth: 1; CodePage: 861),
242	<	(CharsetID: 48; CharSetName: 'DOS866'; CharSetWidth: 1; CodePage: 866),
243	<	(CharsetID: 49; CharSetName: 'DOS869'; CharSetWidth: 1; CodePage: 869),
244	<	(CharsetID: 50; CharSetName: 'CYRL'; CharSetWidth: 1; CodePage: 1251),
245	<	(CharsetID: 51; CharSetName: 'WIN1250'; CharSetWidth: 1; CodePage: 1250),
246	<	(CharsetID: 52; CharSetName: 'WIN1251'; CharSetWidth: 1; CodePage: 1251),
247	<	(CharsetID: 53; CharSetName: 'WIN1252'; CharSetWidth: 1; CodePage: 1252),
248	<	(CharsetID: 54; CharSetName: 'WIN1253'; CharSetWidth: 1; CodePage: 1253),
249	<	(CharsetID: 55; CharSetName: 'WIN1254'; CharSetWidth: 1; CodePage: 1254),
250	<	(CharsetID: 56; CharSetName: 'BIG_5'; CharSetWidth: 2; CodePage: 950),
251	<	(CharsetID: 57; CharSetName: 'GB_2312'; CharSetWidth: 2; CodePage: 936),
252	<	(CharsetID: 58; CharSetName: 'WIN1255'; CharSetWidth: 1; CodePage: 1255),
253	<	(CharsetID: 59; CharSetName: 'WIN1256'; CharSetWidth: 1; CodePage: 1256),
254	<	(CharsetID: 60; CharSetName: 'WIN1257'; CharSetWidth: 1; CodePage: 1257),
255	<	(CharsetID: 61; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
256	<	(CharsetID: 62; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
257	<	(CharsetID: 63; CharSetName: 'KOI8R'; CharSetWidth: 1; CodePage: 20866),
258	<	(CharsetID: 64; CharSetName: 'KOI8U'; CharSetWidth: 1; CodePage: 21866),
259	<	(CharsetID: 65; CharSetName: 'WIN1258'; CharSetWidth: 1; CodePage: 1258),
260	<	(CharsetID: 66; CharSetName: 'TIS620'; CharSetWidth: 1; CodePage: 874),
261	<	(CharsetID: 67; CharSetName: 'GBK'; CharSetWidth: 2; CodePage: 936),
262	<	(CharsetID: 68; CharSetName: 'CP943C'; CharSetWidth: 2; CodePage: 943),
263	<	(CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936)
264	<	);
265	<
266	<	{$IFDEF Unix}
267	<	{SetEnvironmentVariable doesn't exist so we have to use C Library}
268	<	function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
269	<	function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
270	<	function SetEnvironmentVariable(name:PChar; value:PChar):boolean;
271	<	// Set environment variable; if empty string given, remove it.
272	<	begin
273	<	result:=false; //assume failure
274	<	if value = '' then
275	<	begin
276	<	// Assume user wants to remove variable.
277	<	if unsetenv(name)=0 then result:=true;
278	<	end
279	<	else
280	<	begin
281	<	// Non empty so set the variable
282	<	if setenv(name, value, 1)=0 then result:=true;
283	<	end;
284	<	end;
285	<	{$ENDIF}
286	<
287	<	{ TFBClientAPI }
222	>	{ TFBLibrary }
223
224	<	constructor TFBClientAPI.Create;
224	>	function TFBLibrary.GetOverrideLibName: string;
225		begin
226	<	inherited Create;
227	<	LoadIBLibrary;
228	<	if (IBLibrary <> NilHandle) then
226	>	Result := FFBLibraryName;
227	>	if (Result = '') and AllowUseOfFBLIB then
228	>	Result := GetEnvironmentVariable('FBLIB');
229	>	if Result = '' then
230		begin
231	<	SetupEnvironment;
232	<	LoadInterface;
231	>	if assigned(OnGetLibraryName) then
232	>	OnGetLibraryName(Result)
233		end;
298	–	FirebirdClientAPI := self;
234		end;
235
236	<	destructor TFBClientAPI.Destroy;
236	>	procedure TFBLibrary.FreeFBLibrary;
237		begin
238	<	FirebirdClientAPI := nil;
239	<	if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
240	<	UnloadLibrary(IBLibrary);
306	<	IBLibrary := NilHandle;
307	<	inherited Destroy;
238	>	if FIBLibrary <> NilHandle then
239	>	FreeLibrary(FIBLibrary);
240	>	FIBLibrary := NilHandle;
241		end;
242
243	<	procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
311	<	var
312	<	i: Integer;
243	>	function TFBLibrary.GetLibraryName: string;
244		begin
245	<	ReallocMem(Pointer(P), NewSize);
315	<	for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
245	>	Result := ExtractFileName(FFBLibraryName);
246		end;
247
248	<	procedure TFBClientAPI.IBDataBaseError;
248	>	function TFBLibrary.GetFirebirdAPI: IFirebirdAPI;
249		begin
250	<	raise EIBInterBaseError.Create(GetStatus);
250	>	Result := FFirebirdAPI;
251		end;
252
253	<	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
324	<
325	<	procedure TFBClientAPI.SetupEnvironment;
326	<	var TmpDir: string;
253	>	constructor TFBLibrary.Create(aLibPathName: string);
254		begin
255	<	{$IFDEF UNIX}
256	<	TmpDir := GetTempDir +
257	<	DirectorySeparator + 'firebird_' + sysutils.GetEnvironmentVariable('USER');
258	<	if sysutils.GetEnvironmentVariable('FIREBIRD_TMP') = '' then
259	<	begin
260	<	if not DirectoryExists(tmpDir) then
261	<	mkdir(tmpDir);
262	<	SetEnvironmentVariable('FIREBIRD_TMP',PChar(TmpDir));
263	<	end;
264	<	if sysutils.GetEnvironmentVariable('FIREBIRD_LOCK') = '' then
255	>	inherited Create;
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	>	{First try Firebird 3}
269	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
270	>	FFirebirdAPI := nil;
271	>	end;
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	<	if not DirectoryExists(tmpDir) then
281	<	mkdir(tmpDir);
282	<	SetEnvironmentVariable('FIREBIRD_LOCK',PChar(TmpDir));
280	>	{$IFDEF UNIX}
281	>	FreeFBLibrary;
282	>	{$ENDIF}
283	>	if not LoadIBLibrary or not (FFirebirdAPI as TFBClientAPI).LoadInterface then
284	>	FFirebirdAPI := nil;
285		end;
286	<	{$ENDIF}
286	>	end;
287	>	{Note: FFirebirdAPI will be set to nil if the Firebird API fails to load}
288		end;
289
290	<	procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PChar);
290	>	destructor TFBLibrary.Destroy;
291		begin
292	<	while len > 0 do
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	<	buffer^ := char(aValue and $FF);
304	<	Inc(buffer);
305	<	Dec(len);
306	<	aValue := aValue shr 8;
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	<	function TFBClientAPI.IsLibraryLoaded: boolean;
314	>	class procedure TFBLibrary.FreeLibraries;
315	>	var i: integer;
316		begin
317	<	Result := IBLibrary <> NilHandle;
317	>	for i := 0 to Length(FLibraryList) - 1 do
318	>	FLibraryList[i] := nil;
319	>	SetLength(FLibraryList,0);
320		end;
321
322	<	function TFBClientAPI.GetProcAddr(ProcName: PChar): Pointer;
322	>	function TFBLibrary.GetHandle: TLibHandle;
323		begin
324	<	Result := GetProcAddress(IBLibrary, ProcName);
365	<	if not Assigned(Result) then
366	<	raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
324	>	Result := FIBLibrary;
325		end;
326
327	<	function TFBClientAPI.GetOverrideLibName: string;
327	>	{ TFBClientAPI }
328	>
329	>	constructor TFBClientAPI.Create(aFBLibrary: TFBLibrary);
330		begin
331	<	Result := '';
332	<	if AllowUseOfFBLIB then
373	<	Result := GetEnvironmentVariable('FBLIB');
374	<	if Result = '' then
375	<	begin
376	<	if assigned(OnGetLibraryName) then
377	<	OnGetLibraryName(Result)
378	<	end;
331	>	inherited Create;
332	>	FFBLibrary := aFBLibrary;
333		end;
334
335	<	procedure TFBClientAPI.LoadInterface;
335	>	procedure TFBClientAPI.IBAlloc(var P; OldSize, NewSize: Integer);
336	>	var
337	>	i: Integer;
338		begin
339	<	isc_sqlcode := GetProcAddr('isc_sqlcode'); {do not localize}
340	<	isc_sql_interprete := GetProcAddr('isc_sql_interprete'); {do not localize}
385	<	isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
386	<	isc_event_counts := GetProcAddr('isc_event_counts'); {do not localize}
387	<	isc_event_block := GetProcAddr('isc_event_block'); {do not localize}
388	<	isc_free := GetProcAddr('isc_free'); {do not localize}
339	>	ReallocMem(Pointer(P), NewSize);
340	>	for i := OldSize to NewSize - 1 do PAnsiChar(P)[i] := #0;
341		end;
342
343	<	function TFBClientAPI.GetLibraryName: string;
343	>	procedure TFBClientAPI.IBDataBaseError;
344		begin
345	<	Result := FFBLibraryName;
345	>	raise EIBInterBaseError.Create(GetStatus);
346		end;
347
348	<	function TFBClientAPI.GetCharsetName(CharSetID: integer): string;
348	>	{Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
349	>
350	>	procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
351		begin
352	<	Result := '';
353	<	if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
354	<	(CharSetMap[CharSetID].CharSetID = CharSetID) then
355	<	begin
356	<	Result := CharSetMap[CharSetID].CharSetName;
357	<	Exit;
358	<	end;
352	>	while len > 0 do
353	>	begin
354	>	buffer^ := aValue and $FF;
355	>	Inc(buffer);
356	>	Dec(len);
357	>	aValue := aValue shr 8;
358	>	end;
359		end;
360
361	<	function TFBClientAPI.CharSetID2CodePage(CharSetID: integer;
408	<	var CodePage: TSystemCodePage): boolean;
361	>	function TFBClientAPI.IsLibraryLoaded: boolean;
362		begin
363	<	Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
411	<	and (CharSetMap[CharSetID].CharSetID = CharSetID);
412	<	if Result then
413	<	begin
414	<	CodePage := CharSetMap[CharSetID].CodePage;
415	<	Result := true;
416	<	Exit;
417	<	end;
363	>	Result := FFBLibrary.IBLibrary <> NilHandle;
364		end;
365
366	<	function TFBClientAPI.CodePage2CharSetID(CodePage: TSystemCodePage;
421	<	var CharSetID: integer): boolean;
422	<	var i: integer;
366	>	function TFBClientAPI.GetFBLibrary: IFirebirdLibrary;
367		begin
368	<	Result := false;
425	<	for i := Low(CharSetMap) to High(CharSetMap) do
426	<	if CharSetMap[i].CodePage = CodePage then
427	<	begin
428	<	CharSetID := CharSetMap[i].CharSetID;
429	<	Result := true;
430	<	Exit;
431	<	end;
368	>	Result := FFBLibrary;
369		end;
370
371	<	function TFBClientAPI.CharSetName2CharSetID(CharSetName: string;
435	<	var CharSetID: integer): boolean;
436	<	var i: integer;
371	>	function TFBClientAPI.GetImplementationVersion: AnsiString;
372		begin
373	<	Result := false;
439	<	for i := Low(CharSetMap) to High(CharSetMap) do
440	<	if CompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
441	<	begin
442	<	CharSetID := CharSetMap[i].CharSetID;
443	<	Result := true;
444	<	Exit;
445	<	end;
373	>	Result := Format('%d.%d',[GetClientMajor,GetClientMinor]);
374		end;
375
376	<	function TFBClientAPI.CharSetWidth(CharSetID: integer; var Width: integer
449	<	): boolean;
376	>	function TFBClientAPI.GetProcAddr(ProcName: PAnsiChar): Pointer;
377		begin
378	<	Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
379	<	and (CharSetMap[CharSetID].CharSetID = CharSetID);
380	<	if Result then
454	<	begin
455	<	Width := CharSetMap[CharSetID].CharSetWidth;
456	<	Result := true;
457	<	Exit;
458	<	end;
378	>	Result := GetProcAddress(FFBLibrary.IBLibrary, ProcName);
379	>	if not Assigned(Result) then
380	>	raise Exception.CreateFmt(SFirebirdAPIFuncNotFound,[ProcName]);
381		end;
382
383	<	const
384	<	IBLocalBufferLength = 512;
385	<	IBBigLocalBufferLength = IBLocalBufferLength * 2;
386	<	IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
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}
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
393		{ TFBStatus }
394
#	Line 483 | Line 410 | begin
410		Result := isc_sqlcode(PISC_STATUS(StatusVector));
411		end;
412
413	<	function TFBStatus.GetMessage: string;
414	<	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
413	>	function TFBStatus.GetMessage: AnsiString;
414	>	var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
415		IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
416		sqlcode: Long;
490	–	psb: PStatusVector;
417		begin
418		Result := '';
419		IBDataBaseErrorMessages := FIBDataBaseErrorMessages;
#	Line 499 | 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 509 | Line 435 | begin
435		begin
436		if (ShowSQLCode in IBDataBaseErrorMessages) or
437		(ShowSQLMessage in IBDataBaseErrorMessages) then
438	<	Result := Result + CRLF;
439	<	psb := StatusVector;
514	<	with FOwner do
515	<	while (isc_interprete(@local_buffer, @psb) > 0) do
516	<	begin
517	<	if (Result <> '') and (Result[Length(Result)] <> LF) then
518	<	Result := Result + CRLF;
519	<	Result := Result + strpas(local_buffer);
520	<	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 530 | Line 449 | var
449		i: Integer;
450		procedure NextP(i: Integer);
451		begin
452	<	p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
452	>	p := PISC_STATUS(PAnsiChar(p) + (i * SizeOf(ISC_STATUS)));
453		end;
454		begin
455		p := PISC_STATUS(StatusVector);
#	Line 556 | Line 475 | end;
475
476		function TFBStatus.GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
477		begin
478	<	EnterCriticalSection(FIBCS);
478	>	EnterCriticalSection(TFBClientAPI.FIBCS);
479		try
480		result := FIBDataBaseErrorMessages;
481		finally
482	<	LeaveCriticalSection(FIBCS);
482	>	LeaveCriticalSection(TFBClientAPI.FIBCS);
483		end;
484		end;
485
486		procedure TFBStatus.SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
487		begin
488	<	EnterCriticalSection(FIBCS);
488	>	EnterCriticalSection(TFBClientAPI.FIBCS);
489		try
490		FIBDataBaseErrorMessages := Value;
491		finally
492	<	LeaveCriticalSection(FIBCS);
492	>	LeaveCriticalSection(TFBClientAPI.FIBCS);
493		end;
494		end;
495	+
496		initialization
497	<	TFBClientAPI.IBLibrary := NilHandle;
498	<	InitCriticalSection(TFBStatus.FIBCS);
497	>	TFBLibrary.FEnvSetupDone := false;
498	>	{$IFNDEF FPC}
499	>	InitializeCriticalSection(TFBClientAPI.FIBCS);
500	>	{$ELSE}
501	>	InitCriticalSection(TFBClientAPI.FIBCS);
502	>	{$ENDIF}
503
504		finalization
505	<	DoneCriticalSection(TFBStatus.FIBCS);
506	<	if TFBClientAPI.IBLibrary <> NilHandle then
507	<	begin
508	<	FreeLibrary(TFBClientAPI.IBLibrary);
509	<	TFBClientAPI.IBLibrary := NilHandle;
510	<	TFBClientAPI.FFBLibraryName := '';
587	<	end;
588	<
505	>	TFBLibrary.FreeLibraries;
506	>	{$IFNDEF FPC}
507	>	DeleteCriticalSection(TFBClientAPI.FIBCS);
508	>	{$ELSE}
509	>	DoneCriticalSection(TFBClientAPI.FIBCS);
510	>	{$ENDIF}
511		end.
512

Diff Legend

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