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

# User Rev Content
1 tony 263 function TFBLibrary.LoadIBLibrary: boolean;
2 tony 45
3 tony 56 function IsValidHandle(aHandle: TLibHandle): boolean;
4     begin
5     Result := aHandle > HINSTANCE_ERROR;
6     end;
7    
8 tony 45 function DoLoadLibrary(LibName: string): TLibHandle;
9     begin
10     Result := LoadLibrary(PChar(LibName));
11 tony 56 if IsValidHandle(Result) then
12 tony 45 FFBLibraryName := ExtractFileName(LibName);
13     end;
14    
15 tony 56 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 tony 68 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 tony 45 var InstallDir: string;
46     dllPathName: string;
47     oldFirebirdEV: string;
48     begin
49 tony 263 Result := IsValidHandle(FIBLibrary);
50     if Result then Exit;
51 tony 45
52 tony 68 curPath := GetEnvironmentVariable('PATH');
53    
54 tony 45 {First try any user override}
55     dllPathName := GetOverrideLibName;
56     if dllPathName <> '' then
57     begin
58 tony 263 FIBLibrary := DoLoadLibrary(dllPathName);
59     Result := IsValidHandle(FIBLibrary);
60 tony 45 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 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
71 tony 45 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 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
82 tony 45 finally
83 tony 263 if not IsValidHandle(FIBLibrary) then
84 tony 45 SetEnvironmentVariable('FIREBIRD',PChar(oldFirebirdEV)); {restore}
85     end;
86     end;
87    
88     // writeln('Dir = ',InstallDir);
89     {If FIREBIRD environment variable available then try this}
90 tony 263 if not IsValidHandle(FIBLibrary) then
91 tony 45 begin
92     InstallDir := GetEnvironmentVariable('FIREBIRD');
93     if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
94 tony 56 InstallDir := InstallDir + DirectorySeparator;
95 tony 45 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 tony 68 Add2Path(InstallDir);
100 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
101 tony 45 end
102     else
103 tony 68 if (InstallDir <> '') then
104 tony 45 begin
105 tony 68 InstallDir := InstallDir + 'bin' + DirectorySeparator;
106     if FileExists(InstallDir + FIREBIRD_CLIENT) then
107     begin
108     dllPathName := InstallDir + FIREBIRD_CLIENT;
109     Add2Path(InstallDir);
110 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
111 tony 68 end
112 tony 45 end
113     end;
114    
115 tony 263 if not IsValidHandle(FIBLibrary) then
116 tony 68 {Use Registry key if it exists to locate library Firebird 2 only}
117 tony 45 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 tony 68 Add2Path(InstallDir);
128 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
129 tony 45 end
130     end
131     finally
132     Free
133     end;
134    
135     {Now try default install dir}
136 tony 263 if not IsValidHandle(FIBLibrary) then
137 tony 45 begin
138 tony 56 InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
139 tony 68 'Firebird' +
140     DirectorySeparator + 'Firebird_3_0' + DirectorySeparator;
141     dllPathName := InstallDir + FIREBIRD_CLIENT;
142     Add2Path(InstallDir);
143 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
144 tony 45 end;
145    
146 tony 263 if not IsValidHandle(FIBLibrary) then
147 tony 45 begin
148 tony 56 InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
149 tony 68 'Firebird' +
150 tony 45 DirectorySeparator + 'Firebird_2_5' +
151     DirectorySeparator + 'bin' + DirectorySeparator;
152     dllPathName := InstallDir + FIREBIRD_CLIENT;
153 tony 68 Add2Path(InstallDir);
154 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
155 tony 45 end;
156    
157 tony 263 if not IsValidHandle(FIBLibrary) then
158 tony 45 begin
159 tony 56 InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
160 tony 68 'Firebird' +
161 tony 45 DirectorySeparator + 'Firebird_2_1' +
162     DirectorySeparator + 'bin' + DirectorySeparator;
163     dllPathName := InstallDir + FIREBIRD_CLIENT;
164 tony 68 Add2Path(InstallDir);
165 tony 263 FIBLibrary := DoLoadLibrary(dllPathName)
166 tony 45 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 tony 263 if not IsValidHandle(FIBLibrary) then
171 tony 45 begin
172 tony 68 SetEnvironmentVariable('PATH',PChar(curPath));
173 tony 263 FIBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
174     if FIBLibrary <= HINSTANCE_ERROR then
175 tony 45 //well maybe InterBase is present...
176 tony 263 FIBLibrary := DoLoadLibrary(IBASE_DLL);
177 tony 45 end;
178     end;
179 tony 263 Result := IsValidHandle(FIBLibrary);
180 tony 45 end;
181    
182 tony 263 class procedure TFBLibrary.SetupEnvironment;
183     begin
184     end;
185 tony 45
186 tony 263 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;