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) then
  begin
    InstallDir := GetEnvironmentVariable('FIREBIRD');
    if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
      InstallDir := InstallDir + DirectorySeparator;
    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 OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
      begin
        if ValueExists('DefaultInstance') then
        begin
          InstallDir := ReadString('DefaultInstance')  + 'bin' + DirectorySeparator ;
          dllPathName := InstallDir + FIREBIRD_CLIENT;
          Add2Path(InstallDir);
          FIBLibrary := DoLoadLibrary(dllPathName)
        end
      end
    finally
      Free
    end;

    {Now try default install dir}
    if not IsValidHandle(FIBLibrary) then
    begin
      InstallDir := 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 := 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 := 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:	263
Committed:	Thu Dec 6 15:55:01 2018 UTC (5 years, 11 months ago) by tony
Original Path:	*ibx/trunk/fbintf/client/include/wloadlibrary.inc*
File size:	5875 byte(s)
Log Message:	Release 2.3.2 committed
#	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;