client/include/uloadlibrary.inc

function TFBLibrary.LoadIBLibrary: boolean;

  function TryLoadLibrary(LibraryPath: AnsiString; LibNames: TStrings): TLibHandle;
  var i: integer;
  begin
    Result := NilHandle;
    for i := 0 to LibNames.Count - 1 do
    begin
      Result := LoadLibrary(LibraryPath + LibNames[i]);
      if Result <> NilHandle then
      begin
        FFBLibraryName := LibNames[i];
        Exit;
      end;
    end;
  end;

  function FindLibrary(LibNameList: string): TLibHandle;
  var LibNames: TStringList;
      FirebirdDir: Ansistring;
  begin
    Result := NilHandle;
    FirebirdDir :=  IncludeTrailingPathDelimiter(GetEnvironmentVariable('FIREBIRD'));
    LibNames := TStringList.Create;
    try
      LibNames.Delimiter := ':';
      LibNames.StrictDelimiter := true;
      LibNames.DelimitedText := LibNameList; {Split list on semi-colon}
      if FirebirdDir <> '' then
      begin
        Result := TryLoadLibrary(FirebirdDir,LibNames);
        if Result = NilHandle then
          Result := TryLoadLibrary(FirebirdDir + 'lib' + DirectorySeparator,LibNames);
      end;
      if Result = NilHandle then
        Result := TryLoadLibrary('',LibNames);
    finally
      LibNames.Free;
    end;
  end;

var LibName: string;
begin
  Result := FIBLibrary <> NilHandle;
  if Result then Exit;

  LibName := GetOverrideLibName;
  if LibName = '' then
    LibName := (FFirebirdAPI as TFBClientAPI).GetFirebirdLibList;
  FIBLibrary := FindLibrary(LibName);
  {$IFDEF DARWIN}
  if FIBLibrary = NilHandle then
  begin
    {See http://paulbeachsblog.blogspot.co.uk/2008/03/where-is-libfbclientdylib-on-macosx.html
     Try loading direct from Firebird Framework}

    LibName := '/Library/Frameworks/Firebird.framework/Firebird';
    FIBLibrary := LoadLibrary(LibName);
    if FIBLibrary = NilHandle then
    begin
      LibName := '/Library/Frameworks/Firebird.framework/Libraries/libfbclient.dylib';
      FIBLibrary := LoadLibrary(LibName);
    end;
    if FIBLibrary <> NilHandle then
       FFBLibraryName := ExtractFileName(LibName);
  end;
  {$ENDIF}
  Result := FIBLibrary <> NilHandle;
end;

{SetEnvironmentVariable doesn't exist so we have to use C Library}
function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';

function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
// Set environment variable; if empty string given, remove it.
begin
  result:=false; //assume failure
  if value = '' then
  begin
    // Assume user wants to remove variable.
    if unsetenv(name)=0 then result:=true;
  end
  else
  begin
    // Non empty so set the variable
    if setenv(name, value, 1)=0 then result:=true;
  end;
end;

class procedure TFBLibrary.SetupEnvironment;
var TmpDir: AnsiString;
begin
  if FEnvSetupDone then Exit;
    TmpDir := GetTempDir +
        DirectorySeparator + 'firebird_' + sysutils.GetEnvironmentVariable('USER');
    if trim(sysutils.GetEnvironmentVariable('FIREBIRD_TMP')) = '' then
    begin
      if not DirectoryExists(tmpDir) then
        mkdir(tmpDir);
      SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir));
    end;
    if trim(sysutils.GetEnvironmentVariable('FIREBIRD_LOCK')) = '' then
    begin
      if not DirectoryExists(tmpDir) then
        mkdir(tmpDir);
      SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir));
    end;
  FEnvSetupDone := true;
end;

{Type and function definition for dlinfo imported from dlfcn.h}
const
  RTLD_DI_ORIGIN = 6;

type
  Tdlinfo = function (Lib : Pointer; Request: longint; info: pointer) : Longint; cdecl;

function TFBLibrary.GetLibraryFilePath: string;
var path: array [0..IBLocalBufferLength] of char; {hopefully this is big enough}
    dlinfo: Tdlinfo;
begin
  Result := GetLibraryName;
  dlinfo := dlsym(RTLD_DEFAULT,'dlinfo');
  if assigned(dlinfo) then
  begin
    if dlinfo(Pointer(FIBLibrary),RTLD_DI_ORIGIN,@path) = -1 then
      IBError(ibxeDLInfoError,[strpas(dlerror)]);
    Result := strpas(@path) + DirectorySeparator + Result;
  end;

end;


Revision:	308
Committed:	Sat Jul 18 10:26:30 2020 UTC (3 years, 9 months ago) by tony
File size:	4075 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	263	function TFBLibrary.LoadIBLibrary: boolean;
2	tony	45
3	tony	308	function TryLoadLibrary(LibraryPath: AnsiString; LibNames: TStrings): TLibHandle;
4			var i: integer;
5			begin
6			Result := NilHandle;
7			for i := 0 to LibNames.Count - 1 do
8			begin
9			Result := LoadLibrary(LibraryPath + LibNames[i]);
10			if Result <> NilHandle then
11			begin
12			FFBLibraryName := LibNames[i];
13			Exit;
14			end;
15			end;
16			end;
17
18	tony	45	function FindLibrary(LibNameList: string): TLibHandle;
19			var LibNames: TStringList;
20	tony	308	FirebirdDir: Ansistring;
21	tony	45	begin
22			Result := NilHandle;
23	tony	308	FirebirdDir := IncludeTrailingPathDelimiter(GetEnvironmentVariable('FIREBIRD'));
24	tony	45	LibNames := TStringList.Create;
25			try
26			LibNames.Delimiter := ':';
27			LibNames.StrictDelimiter := true;
28			LibNames.DelimitedText := LibNameList; {Split list on semi-colon}
29	tony	308	if FirebirdDir <> '' then
30	tony	45	begin
31	tony	308	Result := TryLoadLibrary(FirebirdDir,LibNames);
32			if Result = NilHandle then
33			Result := TryLoadLibrary(FirebirdDir + 'lib' + DirectorySeparator,LibNames);
34	tony	45	end;
35	tony	308	if Result = NilHandle then
36			Result := TryLoadLibrary('',LibNames);
37	tony	45	finally
38			LibNames.Free;
39			end;
40			end;
41
42			var LibName: string;
43			begin
44	tony	263	Result := FIBLibrary <> NilHandle;
45			if Result then Exit;
46	tony	45
47			LibName := GetOverrideLibName;
48			if LibName = '' then
49	tony	263	LibName := (FFirebirdAPI as TFBClientAPI).GetFirebirdLibList;
50			FIBLibrary := FindLibrary(LibName);
51	tony	45	{$IFDEF DARWIN}
52	tony	263	if FIBLibrary = NilHandle then
53	tony	45	begin
54			{See http://paulbeachsblog.blogspot.co.uk/2008/03/where-is-libfbclientdylib-on-macosx.html
55			Try loading direct from Firebird Framework}
56
57			LibName := '/Library/Frameworks/Firebird.framework/Firebird';
58	tony	263	FIBLibrary := LoadLibrary(LibName);
59			if FIBLibrary = NilHandle then
60	tony	45	begin
61			LibName := '/Library/Frameworks/Firebird.framework/Libraries/libfbclient.dylib';
62	tony	263	FIBLibrary := LoadLibrary(LibName);
63	tony	45	end;
64	tony	263	if FIBLibrary <> NilHandle then
65	tony	209	FFBLibraryName := ExtractFileName(LibName);
66	tony	238	end;
67	tony	45	{$ENDIF}
68	tony	263	Result := FIBLibrary <> NilHandle;
69	tony	45	end;
70
71	tony	263	{SetEnvironmentVariable doesn't exist so we have to use C Library}
72			function setenv(name:Pchar; value:Pchar; replace:integer):integer;cdecl;external clib name 'setenv';
73			function unsetenv(name:Pchar):integer;cdecl;external clib name 'unsetenv';
74	tony	45
75	tony	263	function SetEnvironmentVariable(name:PAnsiChar; value:PAnsiChar):boolean;
76			// Set environment variable; if empty string given, remove it.
77			begin
78			result:=false; //assume failure
79			if value = '' then
80			begin
81			// Assume user wants to remove variable.
82			if unsetenv(name)=0 then result:=true;
83			end
84			else
85			begin
86			// Non empty so set the variable
87			if setenv(name, value, 1)=0 then result:=true;
88			end;
89			end;
90	tony	45
91	tony	263	class procedure TFBLibrary.SetupEnvironment;
92			var TmpDir: AnsiString;
93			begin
94			if FEnvSetupDone then Exit;
95			TmpDir := GetTempDir +
96			DirectorySeparator + 'firebird_' + sysutils.GetEnvironmentVariable('USER');
97			if trim(sysutils.GetEnvironmentVariable('FIREBIRD_TMP')) = '' then
98			begin
99			if not DirectoryExists(tmpDir) then
100			mkdir(tmpDir);
101			SetEnvironmentVariable('FIREBIRD_TMP',PAnsiChar(TmpDir));
102			end;
103			if trim(sysutils.GetEnvironmentVariable('FIREBIRD_LOCK')) = '' then
104			begin
105			if not DirectoryExists(tmpDir) then
106			mkdir(tmpDir);
107			SetEnvironmentVariable('FIREBIRD_LOCK',PAnsiChar(TmpDir));
108			end;
109			FEnvSetupDone := true;
110			end;
111	tony	45
112	tony	263	{Type and function definition for dlinfo imported from dlfcn.h}
113			const
114			RTLD_DI_ORIGIN = 6;
115
116			type
117			Tdlinfo = function (Lib : Pointer; Request: longint; info: pointer) : Longint; cdecl;
118
119			function TFBLibrary.GetLibraryFilePath: string;
120			var path: array [0..IBLocalBufferLength] of char; {hopefully this is big enough}
121			dlinfo: Tdlinfo;
122			begin
123			Result := GetLibraryName;
124			dlinfo := dlsym(RTLD_DEFAULT,'dlinfo');
125			if assigned(dlinfo) then
126			begin
127			if dlinfo(Pointer(FIBLibrary),RTLD_DI_ORIGIN,@path) = -1 then
128			IBError(ibxeDLInfoError,[strpas(dlerror)]);
129			Result := strpas(@path) + DirectorySeparator + Result;
130			end;
131
132			end;
133
134