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