ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/include/wloadlibrary.inc
(Generate patch)

Comparing ibx/trunk/fbintf/client/include/wloadlibrary.inc (file contents):
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

# Line 1 | Line 1
1 < procedure TFBClientAPI.LoadIBLibrary;
1 > function TFBLibrary.LoadIBLibrary: boolean;
2  
3    function IsValidHandle(aHandle: TLibHandle): boolean;
4    begin
# Line 9 | Line 9 | procedure TFBClientAPI.LoadIBLibrary;
9    begin
10      Result := LoadLibrary(PChar(LibName));
11      if IsValidHandle(Result) then
12 –    begin
12        FFBLibraryName := ExtractFileName(LibName);
14 –      FFBLibraryPath := ExtractFileDir(LibName);
15 –    end;
13    end;
14  
15    function GetSpecialFolder(const CSIDL: integer) : string;
# Line 36 | Line 33 | procedure TFBClientAPI.LoadIBLibrary;
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 <  if IsValidHandle(IBLibrary) then Exit;
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 <    IBLibrary := DoLoadLibrary(dllPathName);
59 <    FOwnsIBLibrary := IsValidHandle(IBLibrary);
58 >    FIBLibrary := DoLoadLibrary(dllPathName);
59 >    Result := IsValidHandle(FIBLibrary);
60      Exit;
61    end;
62  
# Line 58 | Line 67 | begin
67    if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
68    begin
69         dllPathName := InstallDir + FIREBIRD_EMBEDDED;
70 <       IBLibrary := DoLoadLibrary(dllPathName)
70 >       FIBLibrary := DoLoadLibrary(dllPathName)
71    end
72    else
73    //Otherwise look for Firebird Client in installation dir
# Line 69 | Line 78 | begin
78      SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
79      dllPathName := InstallDir + FIREBIRD_CLIENT;
80      try
81 <      IBLibrary := DoLoadLibrary(dllPathName)
81 >      FIBLibrary := DoLoadLibrary(dllPathName)
82      finally
83 <      if not IsValidHandle(IBLibrary) then
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(IBLibrary) then
90 >  if not IsValidHandle(FIBLibrary) and (oldFirebirdEV <> '') then
91    begin
92 <    InstallDir := GetEnvironmentVariable('FIREBIRD');
84 <    if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
85 <      InstallDir := InstallDir + DirectorySeparator;
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 <      IBLibrary := DoLoadLibrary(dllPathName)
97 >      Add2Path(InstallDir);
98 >      FIBLibrary := DoLoadLibrary(dllPathName)
99      end
100      else
101 <    if (InstallDir <> '') and FileExists(InstallDir + 'bin' + DirectorySeparator + FIREBIRD_CLIENT) then
101 >    if (InstallDir <> '') then
102      begin
103 <      dllPathName := InstallDir + FIREBIRD_CLIENT;
104 <      IBLibrary := DoLoadLibrary(dllPathName)
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(IBLibrary) then
114 <  {Use Registry key if it exists to locate library}
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 OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
119 >      if OpenKeyReadOnly('SOFTWARE\Firebird Project\Firebird Server\Instances') then
120        begin
121          if ValueExists('DefaultInstance') then
122          begin
123 <          InstallDir := ReadString('DefaultInstance')  + 'bin' + DirectorySeparator ;
123 >          InstallDir := IncludeTrailingPathDelimiter(ReadString('DefaultInstance')) ;
124            dllPathName := InstallDir + FIREBIRD_CLIENT;
125 <          IBLibrary := DoLoadLibrary(dllPathName)
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
# Line 117 | Line 138 | begin
138      end;
139  
140      {Now try default install dir}
141 <    if not IsValidHandle(IBLibrary) then
141 >    if not IsValidHandle(FIBLibrary) then
142      begin
143 <      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
144 <        DirectorySeparator + 'Firebird' +
145 <        DirectorySeparator + 'Firebird_3_0' +
146 <        DirectorySeparator + 'bin' + DirectorySeparator;
147 <      dllPathName := InstallDir + FIREBIRD_CLIENT;
148 <      IBLibrary := DoLoadLibrary(dllPathName)
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(IBLibrary) then
161 >    if not IsValidHandle(FIBLibrary) then
162      begin
163 <      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
164 <        DirectorySeparator + 'Firebird' +
163 >      InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
164 >        'Firebird' +
165          DirectorySeparator + 'Firebird_2_5' +
166          DirectorySeparator + 'bin' + DirectorySeparator;
167        dllPathName := InstallDir + FIREBIRD_CLIENT;
168 <      IBLibrary := DoLoadLibrary(dllPathName)
168 >      Add2Path(InstallDir);
169 >      FIBLibrary := DoLoadLibrary(dllPathName)
170      end;
171  
172 <    if not IsValidHandle(IBLibrary) then
172 >    if not IsValidHandle(FIBLibrary) then
173      begin
174 <      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
175 <        DirectorySeparator + 'Firebird' +
174 >      InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
175 >        'Firebird' +
176          DirectorySeparator + 'Firebird_2_1' +
177          DirectorySeparator + 'bin' + DirectorySeparator;
178        dllPathName := InstallDir + FIREBIRD_CLIENT;
179 <      IBLibrary := DoLoadLibrary(dllPathName)
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(IBLibrary) then
185 >    if not IsValidHandle(FIBLibrary) then
186      begin
187 <      IBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
188 <      if IBLibrary <= HINSTANCE_ERROR then
187 >      SetEnvironmentVariable('PATH',PChar(curPath));
188 >      FIBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
189 >      if FIBLibrary <= HINSTANCE_ERROR then
190         //well maybe InterBase is present...
191 <       IBLibrary := DoLoadLibrary(IBASE_DLL);
191 >       FIBLibrary := DoLoadLibrary(IBASE_DLL);
192      end;
193    end;
194 <  FOwnsIBLibrary := IsValidHandle(IBLibrary);
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;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines