ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/client/FBClientAPI.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBClientAPI.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 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 94 | Line 100 | type
100  
101    TFBStatus = class(TFBInterfacedObject)
102    private
97 –    FIBCS: TRTLCriticalSection; static;
103      FIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
104    protected
105      FOwner: TFBClientAPI;
# Line 105 | Line 110 | type
110      {IStatus}
111      function GetIBErrorCode: Long;
112      function Getsqlcode: Long;
113 <    function GetMessage: string;
113 >    function GetMessage: AnsiString;
114      function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
115      function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
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
155 <    FOwnsIBLibrary: boolean;
119 <    procedure LoadIBLibrary;
155 >    class var FIBCS: TRTLCriticalSection;
156    protected
157 <    FFBLibraryName: string; static;
158 <    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;
157 >    FFBLibrary: TFBLibrary;
158 >    function GetProcAddr(ProcName: PAnsiChar): Pointer;
159    public
160      {Taken from legacy API}
161      isc_sqlcode: Tisc_sqlcode;
# Line 136 | Line 165 | type
165      isc_event_block: Tisc_event_block;
166      isc_free: Tisc_free;
167  
168 <    constructor Create;
140 <    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: PChar);
179 <    function DecodeInteger(bufptr: PChar; len: short): integer; virtual; abstract;
180 <    procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); virtual; abstract;
181 <    function SQLDecodeDate(byfptr: PChar): TDateTime; virtual; abstract;
182 <    procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); virtual; abstract;
183 <    function SQLDecodeTime(bufptr: PChar): TDateTime;  virtual; abstract;
184 <    procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); virtual; abstract;
185 <    function SQLDecodeDateTime(bufptr: PChar): TDateTime; virtual; abstract;
178 >    procedure EncodeInteger(aValue: integer; len: integer; buffer: PByte);
179 >    function DecodeInteger(bufptr: PByte; len: short): integer; virtual; abstract;
180 >    procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); virtual; abstract;
181 >    function SQLDecodeDate(byfptr: PByte): TDateTime; virtual; abstract;
182 >    procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); virtual; abstract;
183 >    function SQLDecodeTime(bufptr: PByte): TDateTime;  virtual; abstract;
184 >    procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); virtual; abstract;
185 >    function SQLDecodeDateTime(bufptr: PByte): TDateTime; virtual; abstract;
186  
187  
188      {IFirebirdAPI}
189      function GetStatus: IStatus; virtual; abstract;
190      function IsLibraryLoaded: boolean;
191      function IsEmbeddedServer: boolean; virtual; abstract;
192 <    function GetLibraryName: string;
193 <    function GetCharsetName(CharSetID: integer): string;
162 <    function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
163 <    function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
164 <    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;
192 >    function GetFBLibrary: IFirebirdLibrary;
193 > end;
194  
195   implementation
196  
197 < uses IBUtils, {$IFDEF Unix} initc, {$ENDIF}
197 > uses IBUtils, Registry,
198 >  {$IFDEF Unix} initc, dl, {$ENDIF}
199 > {$IFDEF FPC}
200   {$IFDEF WINDOWS }
201 < Windows,Registry, WinDirs,
201 > WinDirs,
202 > {$ENDIF}
203 > {$ELSE}
204 > ShlObj,
205   {$ENDIF}
206   SysUtils;
207  
208 + const
209 +  IBLocalBufferLength = 512;
210 +  IBBigLocalBufferLength = IBLocalBufferLength * 2;
211 +  IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
212 +
213   {$IFDEF UNIX}
214 < {$I uloadlibrary.inc}
214 > {$I 'include/uloadlibrary.inc'}
215   {$ELSE}
216 < {$I wloadlibrary.inc}
216 > {$I 'include/wloadlibrary.inc'}
217   {$ENDIF}
218  
219 < type
220 <  TCharsetMap = record
221 <    CharsetID: integer;
222 <    CharSetName: string;
223 <    CharSetWidth: integer;
224 <    CodePage: TSystemCodePage;
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 >    if assigned(OnGetLibraryName) then
230 >      OnGetLibraryName(Result)
231    end;
232 + end;
233  
234 < const
235 <  CharSetMap: array [0..69] of TCharsetMap = (
236 <  (CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_NONE),
237 <  (CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE),
238 <  (CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: CP_ASCII),
239 <  (CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8),
240 <  (CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8),
241 <  (CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932),
242 <  (CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932),
243 <  (CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
244 <  (CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
245 <  (CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737),
246 <  (CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437),
247 <  (CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850),
248 <  (CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865),
249 <  (CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860),
250 <  (CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863),
251 <  (CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775),
252 <  (CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858),
253 <  (CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862),
254 <  (CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864),
255 <  (CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE),
256 <  (CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE),
257 <  (CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591),
258 <  (CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592),
259 <  (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.
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 TFBLibrary.Create(aLibPathName: string);
252 > begin
253 >  inherited Create;
254 >  SetupEnvironment;
255 >  FFBLibraryName := aLibPathName;
256 >  FIBLibrary := NilHandle;
257 >  FFirebirdAPI := GetFirebird3API;
258 >  FRequestedLibName := aLibPathName;
259 >  if aLibPathName <> '' then
260    begin
261 <    result:=false; //assume failure
262 <    if value = '' then
263 <    begin
264 <      // Assume user wants to remove variable.
265 <      if unsetenv(name)=0 then result:=true;
266 <    end
267 <    else
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 >    {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 <      // Non empty so set the variable
279 <      if setenv(name, value, 1)=0 then result:=true;
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 <  {$ENDIF}
285 >  {Note: FFirebirdAPI will be set to nil if the Firebird API fails to load}
286 > end;
287  
288 < { TFBClientAPI }
288 > destructor TFBLibrary.Destroy;
289 > begin
290 >  FFirebirdAPI := nil;
291 >  FreeFBLibrary;
292 >  inherited Destroy;
293 > end;
294  
295 < constructor TFBClientAPI.Create;
295 > class function TFBLibrary.GetFBLibrary(aLibPathName: string): IFirebirdLibrary;
296 > var i: integer;
297   begin
298 <  inherited Create;
299 <  LoadIBLibrary;
293 <  if (IBLibrary <> NilHandle) then
298 >  Result := nil;
299 >  if aLibPathName <> '' then
300    begin
301 <    SetupEnvironment;
302 <    LoadInterface;
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 <  FirebirdClientAPI := self;
309 >
310   end;
311  
312 < destructor TFBClientAPI.Destroy;
312 > class procedure TFBLibrary.FreeLibraries;
313 > var i: integer;
314   begin
315 <  FirebirdClientAPI := nil;
316 <  if FOwnsIBLibrary and (IBLibrary <> NilHandle) then
317 <    UnloadLibrary(IBLibrary);
318 <  IBLibrary := NilHandle;
319 <  inherited Destroy;
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);
# Line 312 | Line 335 | var
335    i: Integer;
336   begin
337    ReallocMem(Pointer(P), NewSize);
338 <  for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
338 >  for i := OldSize to NewSize - 1 do PAnsiChar(P)[i] := #0;
339   end;
340  
341   procedure TFBClientAPI.IBDataBaseError;
# Line 322 | Line 345 | end;
345  
346   {Under Unixes, if using an embedded server then set up local TMP and LOCK Directories}
347  
348 < procedure TFBClientAPI.SetupEnvironment;
326 < var TmpDir: string;
327 < begin
328 <  {$IFDEF UNIX}
329 <    TmpDir := GetTempDir +
330 <        DirectorySeparator + 'firebird_' + sysutils.GetEnvironmentVariable('USER');
331 <    if sysutils.GetEnvironmentVariable('FIREBIRD_TMP') = '' then
332 <    begin
333 <      if not DirectoryExists(tmpDir) then
334 <        mkdir(tmpDir);
335 <      SetEnvironmentVariable('FIREBIRD_TMP',PChar(TmpDir));
336 <    end;
337 <    if sysutils.GetEnvironmentVariable('FIREBIRD_LOCK') = '' then
338 <    begin
339 <      if not DirectoryExists(tmpDir) then
340 <        mkdir(tmpDir);
341 <      SetEnvironmentVariable('FIREBIRD_LOCK',PChar(TmpDir));
342 <    end;
343 <  {$ENDIF}
344 < end;
345 <
346 < procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PChar);
348 > procedure TFBClientAPI.EncodeInteger(aValue: integer; len: integer; buffer: PByte);
349   begin
350    while len > 0 do
351    begin
352 <    buffer^ := char(aValue and $FF);
352 >    buffer^ := aValue and $FF;
353      Inc(buffer);
354      Dec(len);
355      aValue := aValue shr 8;
# Line 356 | 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: PChar): Pointer;
364 > function TFBClientAPI.GetFBLibrary: IFirebirdLibrary;
365   begin
366 <  Result := GetProcAddress(IBLibrary, ProcName);
365 <  if not Assigned(Result) then
366 <    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');
374 <  if Result = '' then
375 <  begin
376 <    if assigned(OnGetLibraryName) then
377 <      OnGetLibraryName(Result)
378 <  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 386 | 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  
391 – function TFBClientAPI.GetLibraryName: string;
392 – begin
393 –  Result := FFBLibraryName;
394 – end;
395 –
396 – function TFBClientAPI.GetCharsetName(CharSetID: integer): string;
397 – begin
398 –  Result := '';
399 –  if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
400 –                                  (CharSetMap[CharSetID].CharSetID = CharSetID) then
401 –    begin
402 –      Result := CharSetMap[CharSetID].CharSetName;
403 –      Exit;
404 –    end;
405 – end;
406 –
407 – function TFBClientAPI.CharSetID2CodePage(CharSetID: integer;
408 –  var CodePage: TSystemCodePage): boolean;
409 – begin
410 –  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;
418 – end;
419 –
420 – function TFBClientAPI.CodePage2CharSetID(CodePage: TSystemCodePage;
421 –  var CharSetID: integer): boolean;
422 – var i: integer;
423 – begin
424 –  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;
432 – end;
433 –
434 – function TFBClientAPI.CharSetName2CharSetID(CharSetName: string;
435 –  var CharSetID: integer): boolean;
436 – var i: integer;
437 – begin
438 –  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;
446 – end;
447 –
448 – function TFBClientAPI.CharSetWidth(CharSetID: integer; var Width: integer
449 –  ): boolean;
450 – begin
451 –  Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
452 –               and (CharSetMap[CharSetID].CharSetID = CharSetID);
453 –  if Result then
454 –    begin
455 –      Width := CharSetMap[CharSetID].CharSetWidth;
456 –      Result := true;
457 –      Exit;
458 –    end;
459 – end;
460 –
461 – const
462 –  IBLocalBufferLength = 512;
463 –  IBBigLocalBufferLength = IBLocalBufferLength * 2;
464 –  IBHugeLocalBufferLength = IBBigLocalBufferLength * 20;
465 –
387   { TFBStatus }
388  
389   constructor TFBStatus.Create(aOwner: TFBClientAPI);
# Line 483 | Line 404 | begin
404      Result := isc_sqlcode(PISC_STATUS(StatusVector));
405   end;
406  
407 < function TFBStatus.GetMessage: string;
408 < var local_buffer: array[0..IBHugeLocalBufferLength - 1] of char;
407 > function TFBStatus.GetMessage: AnsiString;
408 > var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
409      IBDataBaseErrorMessages: TIBDataBaseErrorMessages;
410      sqlcode: Long;
411      psb: PStatusVector;
# Line 530 | Line 451 | var
451    i: Integer;
452    procedure NextP(i: Integer);
453    begin
454 <    p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS)));
454 >    p := PISC_STATUS(PAnsiChar(p) + (i * SizeOf(ISC_STATUS)));
455    end;
456   begin
457    p := PISC_STATUS(StatusVector);
# Line 556 | Line 477 | end;
477  
478   function TFBStatus.GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
479   begin
480 <  EnterCriticalSection(FIBCS);
480 >  EnterCriticalSection(TFBClientAPI.FIBCS);
481    try
482      result := FIBDataBaseErrorMessages;
483    finally
484 <    LeaveCriticalSection(FIBCS);
484 >    LeaveCriticalSection(TFBClientAPI.FIBCS);
485    end;
486   end;
487  
488   procedure TFBStatus.SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
489   begin
490 <  EnterCriticalSection(FIBCS);
490 >  EnterCriticalSection(TFBClientAPI.FIBCS);
491    try
492      FIBDataBaseErrorMessages := Value;
493    finally
494 <    LeaveCriticalSection(FIBCS);
494 >    LeaveCriticalSection(TFBClientAPI.FIBCS);
495    end;
496   end;
497 +
498   initialization
499 <  TFBClientAPI.IBLibrary := NilHandle;
500 <  InitCriticalSection(TFBStatus.FIBCS);
499 >  TFBLibrary.FEnvSetupDone := false;
500 >  {$IFNDEF FPC}
501 >  InitializeCriticalSection(TFBClientAPI.FIBCS);
502 >  {$ELSE}
503 >  InitCriticalSection(TFBClientAPI.FIBCS);
504 >  {$ENDIF}
505  
506   finalization
507 <  DoneCriticalSection(TFBStatus.FIBCS);
508 <  if TFBClientAPI.IBLibrary <> NilHandle then
509 <  begin
510 <    FreeLibrary(TFBClientAPI.IBLibrary);
511 <    TFBClientAPI.IBLibrary := NilHandle;
512 <    TFBClientAPI.FFBLibraryName := '';
587 <  end;
588 <
507 >  TFBLibrary.FreeLibraries;
508 >  {$IFNDEF FPC}
509 >  DeleteCriticalSection(TFBClientAPI.FIBCS);
510 >  {$ELSE}
511 >  DoneCriticalSection(TFBClientAPI.FIBCS);
512 >  {$ENDIF}
513   end.
514  

Diff Legend

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