ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/include/wloadlibrary.inc
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 6512 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
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) and (oldFirebirdEV <> '') then
91 begin
92 InstallDir := IncludeTrailingPathDelimiter(oldFirebirdEV);
93 if (InstallDir <> '') and FileExists(InstallDir + FIREBIRD_CLIENT) then
94 begin
95 //assume firebird.conf and firebird.msg in same dir
96 dllPathName := InstallDir + FIREBIRD_CLIENT;
97 Add2Path(InstallDir);
98 FIBLibrary := DoLoadLibrary(dllPathName)
99 end
100 else
101 if (InstallDir <> '') then
102 begin
103 InstallDir := InstallDir + 'bin' + DirectorySeparator;
104 if FileExists(InstallDir + FIREBIRD_CLIENT) then
105 begin
106 dllPathName := InstallDir + FIREBIRD_CLIENT;
107 Add2Path(InstallDir);
108 FIBLibrary := DoLoadLibrary(dllPathName)
109 end
110 end
111 end;
112
113 if not IsValidHandle(FIBLibrary) then
114 {Use Registry key if it exists to locate library Firebird 2 only}
115 begin
116 with TRegistry.Create do
117 try
118 RootKey := HKEY_LOCAL_MACHINE;
119 if OpenKeyReadOnly('SOFTWARE\Firebird Project\Firebird Server\Instances') then
120 begin
121 if ValueExists('DefaultInstance') then
122 begin
123 InstallDir := IncludeTrailingPathDelimiter(ReadString('DefaultInstance')) ;
124 dllPathName := InstallDir + FIREBIRD_CLIENT;
125 Add2Path(InstallDir);
126 FIBLibrary := DoLoadLibrary(dllPathName);
127 if not IsValidHandle(FIBLibrary) then
128 begin
129 InstallDir := InstallDir + 'bin' + DirectorySeparator ;
130 dllPathName := InstallDir + FIREBIRD_CLIENT;
131 Add2Path(InstallDir);
132 FIBLibrary := DoLoadLibrary(dllPathName)
133 end;
134 end
135 end
136 finally
137 Free
138 end;
139
140 {Now try default install dir}
141 if not IsValidHandle(FIBLibrary) then
142 begin
143 InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
144 'Firebird' +
145 DirectorySeparator + 'Firebird_4_0' + DirectorySeparator;
146 dllPathName := InstallDir + FIREBIRD_CLIENT;
147 Add2Path(InstallDir);
148 FIBLibrary := DoLoadLibrary(dllPathName)
149 end;
150
151 if not IsValidHandle(FIBLibrary) then
152 begin
153 InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
154 'Firebird' +
155 DirectorySeparator + 'Firebird_3_0' + DirectorySeparator;
156 dllPathName := InstallDir + FIREBIRD_CLIENT;
157 Add2Path(InstallDir);
158 FIBLibrary := DoLoadLibrary(dllPathName)
159 end;
160
161 if not IsValidHandle(FIBLibrary) then
162 begin
163 InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
164 'Firebird' +
165 DirectorySeparator + 'Firebird_2_5' +
166 DirectorySeparator + 'bin' + DirectorySeparator;
167 dllPathName := InstallDir + FIREBIRD_CLIENT;
168 Add2Path(InstallDir);
169 FIBLibrary := DoLoadLibrary(dllPathName)
170 end;
171
172 if not IsValidHandle(FIBLibrary) then
173 begin
174 InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
175 'Firebird' +
176 DirectorySeparator + 'Firebird_2_1' +
177 DirectorySeparator + 'bin' + DirectorySeparator;
178 dllPathName := InstallDir + FIREBIRD_CLIENT;
179 Add2Path(InstallDir);
180 FIBLibrary := DoLoadLibrary(dllPathName)
181 end;
182
183 //Otherwise see if Firebird client is in path
184 //and rely on registry for location of firebird.conf and firebird.msg
185 if not IsValidHandle(FIBLibrary) then
186 begin
187 SetEnvironmentVariable('PATH',PChar(curPath));
188 FIBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
189 if FIBLibrary <= HINSTANCE_ERROR then
190 //well maybe InterBase is present...
191 FIBLibrary := DoLoadLibrary(IBASE_DLL);
192 end;
193 end;
194 Result := IsValidHandle(FIBLibrary);
195 end;
196
197 class procedure TFBLibrary.SetupEnvironment;
198 begin
199 end;
200
201 function TFBLibrary.GetLibraryFilePath: string;
202 var buffer: array [0..IBBigLocalBufferLength] of char;
203 nSize: DWORD;
204 begin
205 nSize := GetModuleFileNameA(FIBLibrary,@buffer,IBBigLocalBufferLength+1);
206 if nSize > IBBigLocalBufferLength then
207 buffer[IBBigLocalBufferLength] :=#0;
208 Result := strpas(PAnsiChar(@buffer));
209 end;