client/include/uloadlibrary.inc

function TFBLibrary.LoadIBLibrary: boolean;

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