| 1 |
function TFBLibrary.LoadIBLibrary: boolean;
|
| 2 |
|
| 3 |
function TryLoadLibrary(LibraryPath: AnsiString; LibNames: TStrings): TLibHandle;
|
| 4 |
var i: integer;
|
| 5 |
begin
|
| 6 |
Result := NilHandle;
|
| 7 |
for i := 0 to LibNames.Count - 1 do
|
| 8 |
begin
|
| 9 |
Result := LoadLibrary(LibraryPath + LibNames[i]);
|
| 10 |
if Result <> NilHandle then
|
| 11 |
begin
|
| 12 |
FFBLibraryName := LibNames[i];
|
| 13 |
Exit;
|
| 14 |
end;
|
| 15 |
end;
|
| 16 |
end;
|
| 17 |
|
| 18 |
function FindLibrary(LibNameList: string): TLibHandle;
|
| 19 |
var LibNames: TStringList;
|
| 20 |
FirebirdDir: Ansistring;
|
| 21 |
begin
|
| 22 |
Result := NilHandle;
|
| 23 |
FirebirdDir := IncludeTrailingPathDelimiter(GetEnvironmentVariable('FIREBIRD'));
|
| 24 |
LibNames := TStringList.Create;
|
| 25 |
try
|
| 26 |
LibNames.Delimiter := ':';
|
| 27 |
LibNames.StrictDelimiter := true;
|
| 28 |
LibNames.DelimitedText := LibNameList; {Split list on semi-colon}
|
| 29 |
if FirebirdDir <> '' then
|
| 30 |
begin
|
| 31 |
Result := TryLoadLibrary(FirebirdDir,LibNames);
|
| 32 |
if Result = NilHandle then
|
| 33 |
Result := TryLoadLibrary(FirebirdDir + 'lib' + DirectorySeparator,LibNames);
|
| 34 |
end;
|
| 35 |
if Result = NilHandle then
|
| 36 |
Result := TryLoadLibrary('',LibNames);
|
| 37 |
finally
|
| 38 |
LibNames.Free;
|
| 39 |
end;
|
| 40 |
end;
|
| 41 |
|
| 42 |
var LibName: string;
|
| 43 |
begin
|
| 44 |
Result := FIBLibrary <> NilHandle;
|
| 45 |
if Result then Exit;
|
| 46 |
|
| 47 |
LibName := GetOverrideLibName;
|
| 48 |
if LibName = '' then
|
| 49 |
LibName := (FFirebirdAPI as TFBClientAPI).GetFirebirdLibList;
|
| 50 |
FIBLibrary := FindLibrary(LibName);
|
| 51 |
{$IFDEF DARWIN}
|
| 52 |
if FIBLibrary = NilHandle then
|
| 53 |
begin
|
| 54 |
{See http://paulbeachsblog.blogspot.co.uk/2008/03/where-is-libfbclientdylib-on-macosx.html
|
| 55 |
Try loading direct from Firebird Framework}
|
| 56 |
|
| 57 |
LibName := '/Library/Frameworks/Firebird.framework/Firebird';
|
| 58 |
FIBLibrary := LoadLibrary(LibName);
|
| 59 |
if FIBLibrary = NilHandle then
|
| 60 |
begin
|
| 61 |
LibName := '/Library/Frameworks/Firebird.framework/Libraries/libfbclient.dylib';
|
| 62 |
FIBLibrary := LoadLibrary(LibName);
|
| 63 |
end;
|
| 64 |
if FIBLibrary <> NilHandle then
|
| 65 |
FFBLibraryName := ExtractFileName(LibName);
|
| 66 |
end;
|
| 67 |
{$ENDIF}
|
| 68 |
Result := FIBLibrary <> NilHandle;
|
| 69 |
end;
|
| 70 |
|
| 71 |
{SetEnvironmentVariable doesn't exist so we have to use C Library}
|
| 72 |
function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
|
| 73 |
function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
|
| 74 |
|
| 75 |
function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
|
| 76 |
// Set environment variable; if empty string given, remove it.
|
| 77 |
begin
|
| 78 |
result:=false; //assume failure
|
| 79 |
if value = '' then
|
| 80 |
begin
|
| 81 |
// Assume user wants to remove variable.
|
| 82 |
if unsetenv(name)=0 then result:=true;
|
| 83 |
end
|
| 84 |
else
|
| 85 |
begin
|
| 86 |
// Non empty so set the variable
|
| 87 |
if setenv(name, value, 1)=0 then result:=true;
|
| 88 |
end;
|
| 89 |
end;
|
| 90 |
|
| 91 |
class procedure TFBLibrary.SetupEnvironment;
|
| 92 |
var TmpDir: AnsiString;
|
| 93 |
begin
|
| 94 |
if FEnvSetupDone then Exit;
|
| 95 |
TmpDir := GetTempDir +
|
| 96 |
DirectorySeparator + 'firebird_' + sysutils.GetEnvironmentVariable('USER');
|
| 97 |
if trim(sysutils.GetEnvironmentVariable('FIREBIRD_TMP')) = '' then
|
| 98 |
begin
|
| 99 |
if not DirectoryExists(tmpDir) then
|
| 100 |
mkdir(tmpDir);
|
| 101 |
SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir));
|
| 102 |
end;
|
| 103 |
if trim(sysutils.GetEnvironmentVariable('FIREBIRD_LOCK')) = '' then
|
| 104 |
begin
|
| 105 |
if not DirectoryExists(tmpDir) then
|
| 106 |
mkdir(tmpDir);
|
| 107 |
SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir));
|
| 108 |
end;
|
| 109 |
FEnvSetupDone := true;
|
| 110 |
end;
|
| 111 |
|
| 112 |
{Type and function definition for dlinfo imported from dlfcn.h}
|
| 113 |
const
|
| 114 |
RTLD_DI_ORIGIN = 6;
|
| 115 |
|
| 116 |
type
|
| 117 |
Tdlinfo = function (Lib : Pointer; Request: longint; info: pointer) : Longint; cdecl;
|
| 118 |
|
| 119 |
function TFBLibrary.GetLibraryFilePath: string;
|
| 120 |
var path: array [0..IBLocalBufferLength] of char; {hopefully this is big enough}
|
| 121 |
dlinfo: Tdlinfo;
|
| 122 |
begin
|
| 123 |
Result := GetLibraryName;
|
| 124 |
dlinfo := dlsym(RTLD_DEFAULT,'dlinfo');
|
| 125 |
if assigned(dlinfo) then
|
| 126 |
begin
|
| 127 |
if dlinfo(Pointer(FIBLibrary),RTLD_DI_ORIGIN,@path) = -1 then
|
| 128 |
IBError(ibxeDLInfoError,[strpas(dlerror)]);
|
| 129 |
Result := strpas(@path) + DirectorySeparator + Result;
|
| 130 |
end;
|
| 131 |
|
| 132 |
end;
|
| 133 |
|
| 134 |
|
