ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/include/wloadlibrary.inc
Revision: 68
Committed: Tue Oct 17 10:07:58 2017 UTC (6 years, 5 months ago) by tony
File size: 5525 byte(s)
Log Message:
IBX: Editor Positioning tidy up
FBINTF: Trap uninitialised SQL parameters on SQL Exec. Avoids Unknown SQL Type errors.
Consistent setting of Modified (SQLParam).

File Contents

# Content
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 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 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
65 {Then look in application installation directory}
66 InstallDir := ExtractFilePath(Paramstr(0)); {Using ParamStr(0) assumes windows conventions}
67
68 //First look for Firebird Embedded Server in installation dir
69 if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
70 begin
71 dllPathName := InstallDir + FIREBIRD_EMBEDDED;
72 IBLibrary := DoLoadLibrary(dllPathName)
73 end
74 else
75 //Otherwise look for Firebird Client in installation dir
76 if FileExists(InstallDir + FIREBIRD_CLIENT) then
77 begin
78 //assume firebird.conf and firebird.msg in same dir
79 oldFirebirdEV := GetEnvironmentVariable('FIREBIRD');
80 SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
81 dllPathName := InstallDir + FIREBIRD_CLIENT;
82 try
83 IBLibrary := DoLoadLibrary(dllPathName)
84 finally
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 not IsValidHandle(IBLibrary) then
93 begin
94 InstallDir := GetEnvironmentVariable('FIREBIRD');
95 if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
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 <> '') then
106 begin
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 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
122 RootKey := HKEY_LOCAL_MACHINE;
123 if OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
124 begin
125 if ValueExists('DefaultInstance') then
126 begin
127 InstallDir := ReadString('DefaultInstance') + 'bin' + DirectorySeparator ;
128 dllPathName := InstallDir + FIREBIRD_CLIENT;
129 Add2Path(InstallDir);
130 IBLibrary := DoLoadLibrary(dllPathName)
131 end
132 end
133 finally
134 Free
135 end;
136
137 {Now try default install dir}
138 if not IsValidHandle(IBLibrary) then
139 begin
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 not IsValidHandle(IBLibrary) then
149 begin
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 not IsValidHandle(IBLibrary) then
160 begin
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 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 := IsValidHandle(IBLibrary);
182 end;
183
184