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 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
  if IsValidHandle(IBLibrary) then Exit;

  curPath := GetEnvironmentVariable('PATH');

  {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;
      Add2Path(InstallDir);
      IBLibrary := 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);
        IBLibrary := DoLoadLibrary(dllPathName)
      end
    end
  end;

  if not IsValidHandle(IBLibrary) 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);
          IBLibrary := DoLoadLibrary(dllPathName)
        end
      end
    finally
      Free
    end;

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

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

    if not IsValidHandle(IBLibrary) then
    begin
      InstallDir := GetSpecialFolder(CSIDL_PROGRAM_FILES) +
        'Firebird' +
        DirectorySeparator + 'Firebird_2_1' +
        DirectorySeparator + 'bin' + DirectorySeparator;
      dllPathName := InstallDir + FIREBIRD_CLIENT;
      Add2Path(InstallDir);
      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
      SetEnvironmentVariable('PATH',PChar(curPath));
      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:	68
Committed:	Tue Oct 17 10:07:58 2017 UTC (7 years, 1 month 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).
#	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