client/include/wloadlibrary.inc

function TFBLibrary.LoadIBLibrary: boolean;

  function IsValidHandle(aHandle: TLibHandle): boolean;
  begin
    Result := aHandle > HINSTANCE_ERROR;
  end;

  function DoLoadLibrary(LibName: string): TLibHandle;
  begin
    Result := LoadLibrary(PChar(LibName));
    if IsValidHandle(Result) then
      FFBLibraryName := ExtractFileName(LibName);
  end;

  function GetSpecialFolder(const CSIDL: integer) : string;
  {$IFDEF FPC}
  begin
    Result := GetWindowsSpecialDir(CSIDL);
  end;
  {$ELSE}
  var
    RecPath : PChar;
  begin
    RecPath := StrAlloc(MAX_PATH);
    try
    FillChar(RecPath^, MAX_PATH, 0);
    if SHGetSpecialFolderPath(0, RecPath, CSIDL, false)
      then result := RecPath
      else result := '';
    finally
      StrDispose(RecPath);
    end;
  end;
  {$ENDIF}

var curPath: string;

  procedure Add2Path(dirname: string);
  var newPath: string;
  begin
    newPath := dirname + ';' + curPath;
    SetEnvironmentVariable('PATH',PChar(newPath));
  end;

var InstallDir: string;
    dllPathName: string;
    oldFirebirdEV: string;
begin
  Result := IsValidHandle(FIBLibrary);
  if Result then Exit;

  curPath := GetEnvironmentVariable('PATH');

  {First try any user override}
  dllPathName := GetOverrideLibName;
  if dllPathName <> '' then
  begin
    FIBLibrary := DoLoadLibrary(dllPathName);
    Result := IsValidHandle(FIBLibrary);
    Exit;
  end;

  {Then look in application installation directory}
  InstallDir := ExtractFilePath(Paramstr(0)); {Using ParamStr(0) assumes windows conventions}

  //First look for Firebird Embedded Server in installation dir
  if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
  begin
       dllPathName := InstallDir + FIREBIRD_EMBEDDED;
       FIBLibrary := DoLoadLibrary(dllPathName)
  end
  else
  //Otherwise look for Firebird Client in installation dir
  if FileExists(InstallDir + FIREBIRD_CLIENT) then
  begin
    //assume firebird.conf and firebird.msg in same dir
    oldFirebirdEV := GetEnvironmentVariable('FIREBIRD');
    SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
    dllPathName := InstallDir + FIREBIRD_CLIENT;
    try
      FIBLibrary := DoLoadLibrary(dllPathName)
    finally
      if not IsValidHandle(FIBLibrary) then
        SetEnvironmentVariable('FIREBIRD',PChar(oldFirebirdEV)); {restore}
    end;
  end;

//  writeln('Dir = ',InstallDir);
  {If FIREBIRD environment variable available then try this}
  if not IsValidHandle(FIBLibrary) and (oldFirebirdEV <> '') then
  begin
    InstallDir := IncludeTrailingPathDelimiter(oldFirebirdEV);
    if (InstallDir <> '') and FileExists(InstallDir + FIREBIRD_CLIENT) then
    begin
      //assume firebird.conf and firebird.msg in same dir
      dllPathName := InstallDir + FIREBIRD_CLIENT;
      Add2Path(InstallDir);
      FIBLibrary := DoLoadLibrary(dllPathName)
    end
    else
    if (InstallDir <> '') then
    begin
      InstallDir := InstallDir + 'bin' + DirectorySeparator;
      if FileExists(InstallDir + FIREBIRD_CLIENT) then
      begin
        dllPathName := InstallDir +  FIREBIRD_CLIENT;
        Add2Path(InstallDir);
        FIBLibrary := DoLoadLibrary(dllPathName)
      end
    end
  end;

  if not IsValidHandle(FIBLibrary) then
  {Use Registry key if it exists to locate library Firebird 2 only}
  begin
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly('SOFTWARE\Firebird Project\Firebird Server\Instances') then
      begin
        if ValueExists('DefaultInstance') then
        begin
          InstallDir := IncludeTrailingPathDelimiter(ReadString('DefaultInstance')) ;
          dllPathName := InstallDir + FIREBIRD_CLIENT;
          Add2Path(InstallDir);
          FIBLibrary := DoLoadLibrary(dllPathName);
          if not IsValidHandle(FIBLibrary) then
          begin
            InstallDir := InstallDir  + 'bin' + DirectorySeparator ;
            dllPathName := InstallDir + FIREBIRD_CLIENT;
            Add2Path(InstallDir);
            FIBLibrary := DoLoadLibrary(dllPathName)
          end;
        end
      end
    finally
      Free
    end;

    {Now try default install dir}
    if not IsValidHandle(FIBLibrary) then
    begin
      InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
        'Firebird' +
        DirectorySeparator + 'Firebird_4_0' + DirectorySeparator;
      dllPathName := InstallDir  + FIREBIRD_CLIENT;
      Add2Path(InstallDir);
      FIBLibrary := DoLoadLibrary(dllPathName)
    end;

    if not IsValidHandle(FIBLibrary) then
    begin
      InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
        'Firebird' +
        DirectorySeparator + 'Firebird_3_0' + DirectorySeparator;
      dllPathName := InstallDir  + FIREBIRD_CLIENT;
      Add2Path(InstallDir);
      FIBLibrary := DoLoadLibrary(dllPathName)
    end;

    if not IsValidHandle(FIBLibrary) then
    begin
      InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
        'Firebird' +
        DirectorySeparator + 'Firebird_2_5' +
        DirectorySeparator + 'bin' + DirectorySeparator;
      dllPathName := InstallDir + FIREBIRD_CLIENT;
      Add2Path(InstallDir);
      FIBLibrary := DoLoadLibrary(dllPathName)
    end;

    if not IsValidHandle(FIBLibrary) then
    begin
      InstallDir := IncludeTrailingPathDelimiter(GetSpecialFolder(CSIDL_PROGRAM_FILES)) +
        'Firebird' +
        DirectorySeparator + 'Firebird_2_1' +
        DirectorySeparator + 'bin' + DirectorySeparator;
      dllPathName := InstallDir + FIREBIRD_CLIENT;
      Add2Path(InstallDir);
      FIBLibrary := DoLoadLibrary(dllPathName)
    end;

    //Otherwise see if Firebird client is in path
    //and rely on registry for location of firebird.conf and firebird.msg
    if not IsValidHandle(FIBLibrary) then
    begin
      SetEnvironmentVariable('PATH',PChar(curPath));
      FIBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
      if FIBLibrary <= HINSTANCE_ERROR then
       //well maybe InterBase is present...
       FIBLibrary := DoLoadLibrary(IBASE_DLL);
    end;
  end;
  Result := IsValidHandle(FIBLibrary);
end;

class procedure TFBLibrary.SetupEnvironment;
begin
end;

function TFBLibrary.GetLibraryFilePath: string;
var buffer: array [0..IBBigLocalBufferLength] of char;
    nSize: DWORD;
begin
  nSize := GetModuleFileNameA(FIBLibrary,@buffer,IBBigLocalBufferLength+1);
  if nSize > IBBigLocalBufferLength then
    buffer[IBBigLocalBufferLength] :=#0;
  Result := strpas(PAnsiChar(@buffer));
end;
Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 2 months ago) by tony
File size:	6512 byte(s)
Log Message:	Updated for IBX 4 release
#	Content
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;