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

File Contents

# Content
1 function TFBLibrary.LoadIBLibrary: boolean;
2
3 function IsValidHandle(aHandle: TLibHandle): boolean;
4 begin
5 Result := aHandle > HINSTANCE_ERROR;
6 end;
7
8 function DoLoadLibrary(LibName: string): TLibHandle;
9 begin
10 Result := LoadLibrary(PChar(LibName));
11 if IsValidHandle(Result) then
12 FFBLibraryName := ExtractFileName(LibName);
13 end;
14
15 function GetSpecialFolder(const CSIDL: integer) : string;
16 {$IFDEF FPC}
17 begin
18 Result := GetWindowsSpecialDir(CSIDL);
19 end;
20 {$ELSE}
21 var
22 RecPath : PChar;
23 begin
24 RecPath := StrAlloc(MAX_PATH);
25 try
26 FillChar(RecPath^, MAX_PATH, 0);
27 if SHGetSpecialFolderPath(0, RecPath, CSIDL, false)
28 then result := RecPath
29 else result := '';
30 finally
31 StrDispose(RecPath);
32 end;
33 end;
34 {$ENDIF}
35
36 var curPath: string;
37
38 procedure Add2Path(dirname: string);
39 var newPath: string;
40 begin
41 newPath := dirname + ';' + curPath;
42 SetEnvironmentVariable('PATH',PChar(newPath));
43 end;
44
45 var InstallDir: string;
46 dllPathName: string;
47 oldFirebirdEV: string;
48 begin
49 Result := IsValidHandle(FIBLibrary);
50 if Result then Exit;
51
52 curPath := GetEnvironmentVariable('PATH');
53
54 {First try any user override}
55 dllPathName := GetOverrideLibName;
56 if dllPathName <> '' then
57 begin
58 FIBLibrary := DoLoadLibrary(dllPathName);
59 Result := IsValidHandle(FIBLibrary);
60 Exit;
61 end;
62
63 {Then look in application installation directory}
64 InstallDir := ExtractFilePath(Paramstr(0)); {Using ParamStr(0) assumes windows conventions}
65
66 //First look for Firebird Embedded Server in installation dir
67 if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
68 begin
69 dllPathName := InstallDir + FIREBIRD_EMBEDDED;
70 FIBLibrary := DoLoadLibrary(dllPathName)
71 end
72 else
73 //Otherwise look for Firebird Client in installation dir
74 if FileExists(InstallDir + FIREBIRD_CLIENT) then
75 begin
76 //assume firebird.conf and firebird.msg in same dir
77 oldFirebirdEV := GetEnvironmentVariable('FIREBIRD');
78 SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
79 dllPathName := InstallDir + FIREBIRD_CLIENT;
80 try
81 FIBLibrary := DoLoadLibrary(dllPathName)
82 finally
83 if not IsValidHandle(FIBLibrary) then
84 SetEnvironmentVariable('FIREBIRD',PChar(oldFirebirdEV)); {restore}
85 end;
86 end;
87
88 // writeln('Dir = ',InstallDir);
89 {If FIREBIRD environment variable available then try this}
90 if not IsValidHandle(FIBLibrary) then
91 begin
92 InstallDir := GetEnvironmentVariable('FIREBIRD');
93 if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
94 InstallDir := InstallDir + DirectorySeparator;
95 if (InstallDir <> '') and FileExists(InstallDir + FIREBIRD_CLIENT) then
96 begin
97 //assume firebird.conf and firebird.msg in same dir
98 dllPathName := InstallDir + FIREBIRD_CLIENT;
99 Add2Path(InstallDir);
100 FIBLibrary := DoLoadLibrary(dllPathName)
101 end
102 else
103 if (InstallDir <> '') then
104 begin
105 InstallDir := InstallDir + 'bin' + DirectorySeparator;
106 if FileExists(InstallDir + FIREBIRD_CLIENT) then
107 begin
108 dllPathName := InstallDir + FIREBIRD_CLIENT;
109 Add2Path(InstallDir);
110 FIBLibrary := DoLoadLibrary(dllPathName)
111 end
112 end
113 end;
114
115 if not IsValidHandle(FIBLibrary) then
116 {Use Registry key if it exists to locate library Firebird 2 only}
117 begin
118 with TRegistry.Create do
119 try
120 RootKey := HKEY_LOCAL_MACHINE;
121 if OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
122 begin
123 if ValueExists('DefaultInstance') then
124 begin
125 InstallDir := ReadString('DefaultInstance') + 'bin' + DirectorySeparator ;
126 dllPathName := InstallDir + FIREBIRD_CLIENT;
127 Add2Path(InstallDir);
128 FIBLibrary := DoLoadLibrary(dllPathName)
129 end
130 end
131 finally
132 Free
133 end;
134
135 {Now try default install dir}
136 if not IsValidHandle(FIBLibrary) then
137 begin
138 InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
139 'Firebird' +
140 DirectorySeparator + 'Firebird_3_0' + DirectorySeparator;
141 dllPathName := InstallDir + FIREBIRD_CLIENT;
142 Add2Path(InstallDir);
143 FIBLibrary := DoLoadLibrary(dllPathName)
144 end;
145
146 if not IsValidHandle(FIBLibrary) then
147 begin
148 InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
149 'Firebird' +
150 DirectorySeparator + 'Firebird_2_5' +
151 DirectorySeparator + 'bin' + DirectorySeparator;
152 dllPathName := InstallDir + FIREBIRD_CLIENT;
153 Add2Path(InstallDir);
154 FIBLibrary := DoLoadLibrary(dllPathName)
155 end;
156
157 if not IsValidHandle(FIBLibrary) then
158 begin
159 InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
160 'Firebird' +
161 DirectorySeparator + 'Firebird_2_1' +
162 DirectorySeparator + 'bin' + DirectorySeparator;
163 dllPathName := InstallDir + FIREBIRD_CLIENT;
164 Add2Path(InstallDir);
165 FIBLibrary := DoLoadLibrary(dllPathName)
166 end;
167
168 //Otherwise see if Firebird client is in path
169 //and rely on registry for location of firebird.conf and firebird.msg
170 if not IsValidHandle(FIBLibrary) then
171 begin
172 SetEnvironmentVariable('PATH',PChar(curPath));
173 FIBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
174 if FIBLibrary <= HINSTANCE_ERROR then
175 //well maybe InterBase is present...
176 FIBLibrary := DoLoadLibrary(IBASE_DLL);
177 end;
178 end;
179 Result := IsValidHandle(FIBLibrary);
180 end;
181
182 class procedure TFBLibrary.SetupEnvironment;
183 begin
184 end;
185
186 function TFBLibrary.GetLibraryFilePath: string;
187 var buffer: array [0..IBBigLocalBufferLength] of char;
188 nSize: DWORD;
189 begin
190 nSize := GetModuleFileNameA(FIBLibrary,@buffer,IBBigLocalBufferLength+1);
191 if nSize > IBBigLocalBufferLength then
192 buffer[IBBigLocalBufferLength] :=#0;
193 Result := strpas(PAnsiChar(@buffer));
194 end;