ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/include/uloadlibrary.inc
Revision: 263
Committed: Thu Dec 6 15:55:01 2018 UTC (5 years, 3 months ago) by tony
File size: 3524 byte(s)
Log Message:
Release 2.3.2 committed

File Contents

# Content
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