client/include/wloadlibrary.inc

procedure TFBClientAPI.LoadIBLibrary;

  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
    begin
      FFBLibraryName := ExtractFileName(LibName);
      FFBLibraryPath := ExtractFileDir(LibName);
    end;
  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 InstallDir: string;
    dllPathName: string;
    oldFirebirdEV: string;
begin
  if IsValidHandle(IBLibrary) then Exit;

  {First try any user override}
  dllPathName := GetOverrideLibName;
  if dllPathName <> '' then
  begin
    IBLibrary := DoLoadLibrary(dllPathName);
    FOwnsIBLibrary := IsValidHandle(IBLibrary);
    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;
       IBLibrary := 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
      IBLibrary := DoLoadLibrary(dllPathName)
    finally
      if not IsValidHandle(IBLibrary) then
        SetEnvironmentVariable('FIREBIRD',PChar(oldFirebirdEV)); {restore}
    end;
  end;

//  writeln('Dir = ',InstallDir);
  {If FIREBIRD environment variable available then try this}
  if not IsValidHandle(IBLibrary) 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;
      IBLibrary := DoLoadLibrary(dllPathName)
    end
    else
    if (InstallDir <> '') and FileExists(InstallDir + 'bin' + DirectorySeparator + FIREBIRD_CLIENT) then
    begin
      dllPathName := InstallDir + FIREBIRD_CLIENT;
      IBLibrary := DoLoadLibrary(dllPathName)
    end
  end;

  if not IsValidHandle(IBLibrary) then
  {Use Registry key if it exists to locate library}
  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;
          IBLibrary := DoLoadLibrary(dllPathName)
        end
      end
    finally
      Free
    end;

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

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

    if not IsValidHandle(IBLibrary) then
    begin
      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
        DirectorySeparator + 'Firebird' +
        DirectorySeparator + 'Firebird_2_1' +
        DirectorySeparator + 'bin' + DirectorySeparator;
      dllPathName := InstallDir + FIREBIRD_CLIENT;
      IBLibrary := 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(IBLibrary) then
    begin
      IBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
      if IBLibrary <= HINSTANCE_ERROR then
       //well maybe InterBase is present...
       IBLibrary := DoLoadLibrary(IBASE_DLL);
    end;
  end;
  FOwnsIBLibrary := IsValidHandle(IBLibrary);
end;


Revision:	56
Committed:	Mon Mar 6 10:20:02 2017 UTC (7 years, 1 month ago) by tony
File size:	5075 byte(s)
Log Message:	Committing updates for Trunk
#	User	Rev	Content
1	tony	45	procedure TFBClientAPI.LoadIBLibrary;
2
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	begin
13			FFBLibraryName := ExtractFileName(LibName);
14			FFBLibraryPath := ExtractFileDir(LibName);
15			end;
16			end;
17
18	tony	56	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	tony	45	var InstallDir: string;
40			dllPathName: string;
41			oldFirebirdEV: string;
42			begin
43	tony	56	if IsValidHandle(IBLibrary) then Exit;
44	tony	45
45			{First try any user override}
46			dllPathName := GetOverrideLibName;
47			if dllPathName <> '' then
48			begin
49			IBLibrary := DoLoadLibrary(dllPathName);
50	tony	56	FOwnsIBLibrary := IsValidHandle(IBLibrary);
51	tony	45	Exit;
52			end;
53
54			{Then look in application installation directory}
55			InstallDir := ExtractFilePath(Paramstr(0)); {Using ParamStr(0) assumes windows conventions}
56
57			//First look for Firebird Embedded Server in installation dir
58			if FileExists(InstallDir + FIREBIRD_EMBEDDED) then
59			begin
60			dllPathName := InstallDir + FIREBIRD_EMBEDDED;
61			IBLibrary := DoLoadLibrary(dllPathName)
62			end
63			else
64			//Otherwise look for Firebird Client in installation dir
65			if FileExists(InstallDir + FIREBIRD_CLIENT) then
66			begin
67			//assume firebird.conf and firebird.msg in same dir
68			oldFirebirdEV := GetEnvironmentVariable('FIREBIRD');
69			SetEnvironmentVariable('FIREBIRD',PChar(InstallDir));
70			dllPathName := InstallDir + FIREBIRD_CLIENT;
71			try
72			IBLibrary := DoLoadLibrary(dllPathName)
73			finally
74	tony	56	if not IsValidHandle(IBLibrary) then
75	tony	45	SetEnvironmentVariable('FIREBIRD',PChar(oldFirebirdEV)); {restore}
76			end;
77			end;
78
79			// writeln('Dir = ',InstallDir);
80			{If FIREBIRD environment variable available then try this}
81	tony	56	if not IsValidHandle(IBLibrary) then
82	tony	45	begin
83			InstallDir := GetEnvironmentVariable('FIREBIRD');
84			if (length(InstallDir) > 0) and (InstallDir[length(InstallDir)] <> DirectorySeparator) then
85	tony	56	InstallDir := InstallDir + DirectorySeparator;
86	tony	45	if (InstallDir <> '') and FileExists(InstallDir + FIREBIRD_CLIENT) then
87			begin
88			//assume firebird.conf and firebird.msg in same dir
89			dllPathName := InstallDir + FIREBIRD_CLIENT;
90			IBLibrary := DoLoadLibrary(dllPathName)
91			end
92			else
93			if (InstallDir <> '') and FileExists(InstallDir + 'bin' + DirectorySeparator + FIREBIRD_CLIENT) then
94			begin
95			dllPathName := InstallDir + FIREBIRD_CLIENT;
96			IBLibrary := DoLoadLibrary(dllPathName)
97			end
98			end;
99
100	tony	56	if not IsValidHandle(IBLibrary) then
101	tony	45	{Use Registry key if it exists to locate library}
102			begin
103			with TRegistry.Create do
104			try
105			RootKey := HKEY_LOCAL_MACHINE;
106			if OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
107			begin
108			if ValueExists('DefaultInstance') then
109			begin
110			InstallDir := ReadString('DefaultInstance') + 'bin' + DirectorySeparator ;
111			dllPathName := InstallDir + FIREBIRD_CLIENT;
112			IBLibrary := DoLoadLibrary(dllPathName)
113			end
114			end
115			finally
116			Free
117			end;
118
119			{Now try default install dir}
120	tony	56	if not IsValidHandle(IBLibrary) then
121	tony	45	begin
122	tony	56	InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
123	tony	45	DirectorySeparator + 'Firebird' +
124			DirectorySeparator + 'Firebird_3_0' +
125			DirectorySeparator + 'bin' + DirectorySeparator;
126			dllPathName := InstallDir + FIREBIRD_CLIENT;
127			IBLibrary := DoLoadLibrary(dllPathName)
128			end;
129
130	tony	56	if not IsValidHandle(IBLibrary) then
131	tony	45	begin
132	tony	56	InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
133	tony	45	DirectorySeparator + 'Firebird' +
134			DirectorySeparator + 'Firebird_2_5' +
135			DirectorySeparator + 'bin' + DirectorySeparator;
136			dllPathName := InstallDir + FIREBIRD_CLIENT;
137			IBLibrary := DoLoadLibrary(dllPathName)
138			end;
139
140	tony	56	if not IsValidHandle(IBLibrary) then
141	tony	45	begin
142	tony	56	InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
143	tony	45	DirectorySeparator + 'Firebird' +
144			DirectorySeparator + 'Firebird_2_1' +
145			DirectorySeparator + 'bin' + DirectorySeparator;
146			dllPathName := InstallDir + FIREBIRD_CLIENT;
147			IBLibrary := DoLoadLibrary(dllPathName)
148			end;
149
150			//Otherwise see if Firebird client is in path
151			//and rely on registry for location of firebird.conf and firebird.msg
152	tony	56	if not IsValidHandle(IBLibrary) then
153	tony	45	begin
154			IBLibrary := DoLoadLibrary(FIREBIRD_CLIENT);
155			if IBLibrary <= HINSTANCE_ERROR then
156			//well maybe InterBase is present...
157			IBLibrary := DoLoadLibrary(IBASE_DLL);
158			end;
159			end;
160	tony	56	FOwnsIBLibrary := IsValidHandle(IBLibrary);
161	tony	45	end;
162
163