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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 68 by tony, Tue Oct 17 10:07:58 2017 UTC

# Line 1 | Line 1
1   procedure TFBClientAPI.LoadIBLibrary;
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 Result <> NilHandle then
11 >    if IsValidHandle(Result) then
12      begin
13        FFBLibraryName := ExtractFileName(LibName);
14        FFBLibraryPath := ExtractFileDir(LibName);
15      end;
16    end;
17  
18 +  function GetSpecialFolder(const CSIDL: integer) : string;
19 +  {$IFDEF FPC}
20 +  begin
21 +    Result := GetWindowsSpecialDir(CSIDL);
22 +  end;
23 +  {$ELSE}
24 +  var
25 +    RecPath : PChar;
26 +  begin
27 +    RecPath := StrAlloc(MAX_PATH);
28 +    try
29 +    FillChar(RecPath^, MAX_PATH, 0);
30 +    if SHGetSpecialFolderPath(0, RecPath, CSIDL, false)
31 +      then result := RecPath
32 +      else result := '';
33 +    finally
34 +      StrDispose(RecPath);
35 +    end;
36 +  end;
37 +  {$ENDIF}
38 +
39 + var curPath: string;
40 +
41 +  procedure Add2Path(dirname: string);
42 +  var newPath: string;
43 +  begin
44 +    newPath := dirname + ';' + curPath;
45 +    SetEnvironmentVariable('PATH',PChar(newPath));
46 +  end;
47 +
48   var InstallDir: string;
49      dllPathName: string;
50      oldFirebirdEV: string;
51   begin
52 <  if IBLibrary <> NilHandle then Exit;
52 >  if IsValidHandle(IBLibrary) then Exit;
53 >
54 >  curPath := GetEnvironmentVariable('PATH');
55  
56    {First try any user override}
57    dllPathName := GetOverrideLibName;
58    if dllPathName <> '' then
59    begin
60      IBLibrary := DoLoadLibrary(dllPathName);
61 +    FOwnsIBLibrary := IsValidHandle(IBLibrary);
62      Exit;
63    end;
64  
# Line 44 | Line 82 | begin
82      try
83        IBLibrary := DoLoadLibrary(dllPathName)
84      finally
85 <      if IBLibrary = NILHandle then
85 >      if not IsValidHandle(IBLibrary) then
86          SetEnvironmentVariable('FIREBIRD',PChar(oldFirebirdEV)); {restore}
87      end;
88    end;
89  
90   //  writeln('Dir = ',InstallDir);
91    {If FIREBIRD environment variable available then try this}
92 <  if IBLibrary = NilHandle then
92 >  if not IsValidHandle(IBLibrary) then
93    begin
94      InstallDir := GetEnvironmentVariable('FIREBIRD');
95      if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
96 <      InstallDir += DirectorySeparator;
96 >      InstallDir := InstallDir + DirectorySeparator;
97      if (InstallDir <> '') and FileExists(InstallDir + FIREBIRD_CLIENT) then
98      begin
99        //assume firebird.conf and firebird.msg in same dir
100        dllPathName := InstallDir + FIREBIRD_CLIENT;
101 +      Add2Path(InstallDir);
102        IBLibrary := DoLoadLibrary(dllPathName)
103      end
104      else
105 <    if (InstallDir <> '') and FileExists(InstallDir + 'bin' + DirectorySeparator + FIREBIRD_CLIENT) then
105 >    if (InstallDir <> '') then
106      begin
107 <      dllPathName := InstallDir + FIREBIRD_CLIENT;
108 <      IBLibrary := DoLoadLibrary(dllPathName)
107 >      InstallDir := InstallDir + 'bin' + DirectorySeparator;
108 >      if FileExists(InstallDir + FIREBIRD_CLIENT) then
109 >      begin
110 >        dllPathName := InstallDir +  FIREBIRD_CLIENT;
111 >        Add2Path(InstallDir);
112 >        IBLibrary := DoLoadLibrary(dllPathName)
113 >      end
114      end
115    end;
116  
117 <  if IBLibrary = NilHandle then
118 <  {Use Registry key if it exists to locate library}
117 >  if not IsValidHandle(IBLibrary) then
118 >  {Use Registry key if it exists to locate library Firebird 2 only}
119    begin
120      with TRegistry.Create do
121      try
# Line 82 | Line 126 | begin
126          begin
127            InstallDir := ReadString('DefaultInstance')  + 'bin' + DirectorySeparator ;
128            dllPathName := InstallDir + FIREBIRD_CLIENT;
129 +          Add2Path(InstallDir);
130            IBLibrary := DoLoadLibrary(dllPathName)
131          end
132        end
# Line 90 | Line 135 | begin
135      end;
136  
137      {Now try default install dir}
138 <    if IBLibrary = NilHandle then
138 >    if not IsValidHandle(IBLibrary) then
139      begin
140 <      InstallDir := GetWindowsSpecialDir(CSIDL_PROGRAM_FILES) +
141 <        DirectorySeparator + 'Firebird' +
142 <        DirectorySeparator + 'Firebird_3_0' +
143 <        DirectorySeparator + 'bin' + DirectorySeparator;
144 <      dllPathName := InstallDir + FIREBIRD_CLIENT;
140 >      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
141 >        'Firebird' +
142 >        DirectorySeparator + 'Firebird_3_0' + DirectorySeparator;
143 >      dllPathName := InstallDir  + FIREBIRD_CLIENT;
144 >      Add2Path(InstallDir);
145        IBLibrary := DoLoadLibrary(dllPathName)
146      end;
147  
148 <    if IBLibrary = NilHandle then
148 >    if not IsValidHandle(IBLibrary) then
149      begin
150 <      InstallDir := GetWindowsSpecialDir(CSIDL_PROGRAM_FILES) +
151 <        DirectorySeparator + 'Firebird' +
150 >      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
151 >        'Firebird' +
152          DirectorySeparator + 'Firebird_2_5' +
153          DirectorySeparator + 'bin' + DirectorySeparator;
154        dllPathName := InstallDir + FIREBIRD_CLIENT;
155 +      Add2Path(InstallDir);
156        IBLibrary := DoLoadLibrary(dllPathName)
157      end;
158  
159 <    if IBLibrary = NilHandle then
159 >    if not IsValidHandle(IBLibrary) then
160      begin
161 <      InstallDir := GetWindowsSpecialDir(CSIDL_PROGRAM_FILES) +
162 <        DirectorySeparator + 'Firebird' +
161 >      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
162 >        'Firebird' +
163          DirectorySeparator + 'Firebird_2_1' +
164          DirectorySeparator + 'bin' + DirectorySeparator;
165        dllPathName := InstallDir + FIREBIRD_CLIENT;
166 +      Add2Path(InstallDir);
167        IBLibrary := DoLoadLibrary(dllPathName)
168      end;
169  
170      //Otherwise see if Firebird client is in path
171      //and rely on registry for location of firebird.conf and firebird.msg
172 <    if IBLibrary = NilHandle then
172 >    if not IsValidHandle(IBLibrary) then
173      begin
174 +      SetEnvironmentVariable('PATH',PChar(curPath));
175        IBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
176        if IBLibrary <= HINSTANCE_ERROR then
177         //well maybe InterBase is present...
178         IBLibrary := DoLoadLibrary(IBASE_DLL);
179      end;
180    end;
181 <  FOwnsIBLibrary := IBLibrary <> NilHandle;
181 >  FOwnsIBLibrary := IsValidHandle(IBLibrary);
182   end;
183  
184  

Diff Legend

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