1 //可支持android和linux
 2 uses
 3   {$IFDEF FPC}
 4   {$IFDEF UNIX}  
 5   //BaseUnix, Unix,
 6   dl;
 7   {$ENDIF}
 8   {$ENDIF} 
 9 type  
10   HMODULE = Cardinal; 
11 {$IFDEF FPC}
12 {$IFDEF UNIX}
13 function GetModuleFileName(hLib: HMODULE):string;
14 var
15   dlinfo: dl_info;
16   IsLib: Boolean;
17 begin
18   19   if hLib=0 then
20     hLib := HMODULE(@GetModuleFileName);
21 
22   dladdr(Pointer(hLib), @dlinfo);
23   Result:=string(dlinfo.dli_fname);
24 end;
25 {$ENDIF}
26 {$ENDIF}

  1 //支持android, MacOS没测试，可能会有问题但原理是正确的
  2 uses
  3   {$IFDEF POSIX}
  4   Posix.Base,
  5   Posix.Dlfcn,
  6   {$ENDIF}
  7   Classes, SysUtils;
  8 
  9 type
 10   HMODULE = Cardinal;
 11 
 12 {$IFNDEF FPC}
 13 {$IFDEF ANDROID}
 14 //Posix.Dlfcn中android版本的dladdr只返回模块名称，不返回全路径
 15 //因此需要自己实现dladdr
 16 threadvar
 17   _ModuleName: MarshaledAString;
 18 
 19 function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl;
 20 var
 21   F: Text;
 22   s, ss, curnode: string;
 23   a1, a2, curbase: UIntPtr;
 24   //i: longint;
 25   p, pp: PByte;
 26   M: TMarshaller;
 27 begin
 28   Result:=0;
 29   _ModuleName:='';
 30   if info = nil then
 31     exit;
 32   curbase:=0;
 33   curnode:='';
 34   Assign(F, '/proc/self/maps');
 35   Reset(F);
 36   if IoResult <> 0 then
 37     exit;
 38   while not Eof(F) do
 39     begin
 40       // Read the address range info
 41       ReadLn(F, ss);
 42       p:=PByte(M.AsAnsi(ss, CP_UTF8).ToPointer);
 43       // Starting address
 44       pp:=p;
 45       while not (p^ in [Byte(Ord('-')), Byte(Ord(#0))]) do
 46         Inc(p);
 47       p^ := Byte(Ord(#0));
 48 
 49       s := UTF8ToString(MarshaledAString(pp));
 50       a1 := StrToIntDef('$'+s, 0);
 51         if a1 > 0 then
 52         begin
 53           // Ending address
 54           Inc(p);
 55           pp:=p;
 56           while p^ > Byte(Ord(' ')) do
 57             Inc(p);
 58           p^ := Byte(Ord(#0));
 59 
 60           s := UTF8ToString(MarshaledAString(pp));
 61           a2 := StrToIntDef('$'+s, 0);
 62 
 63             if a2 > 0 then
 64             begin
 65               while p^ <= Byte(Ord(' ')) do Inc(p);  // Whitespace
 66               while p^ > Byte(Ord(' ')) do Inc(p);   // Skip perms
 67               while p^ <= Byte(Ord(' ')) do Inc(p);  // Whitespace
 68               while p^ > Byte(Ord(' ')) do Inc(p);   // Skip offset
 69               while p^ <= Byte(Ord(' ')) do Inc(p);  // Whitespace
 70               while p^ > Byte(Ord(' ')) do Inc(p);   // Skip dev
 71               while p^ <= Byte(Ord(' ')) do Inc(p);  // Whitespace
 72               // inode
 73               pp:=p;
 74               while p^ > Byte(Ord(' ')) do
 75                 Inc(p);
 76               p^ := Byte(Ord(#0));
 77 
 78               s := UTF8ToString(MarshaledAString(pp));
 79 
 80                 if s <> '0' then
 81                 begin
 82                     if s <> curnode then
 83                     begin
 84                       curnode:=s;
 85                       curbase:=a1;
 86                     end;
 87 
 88                     if (UIntPtr(Lib) >= a1) and (UIntPtr(Lib) < a2) then
 89                     begin
 90                       while p^ <= Byte(Ord(' ')) do Inc(p);  // Whitespace
 91                       // File name
 92                         if p^ = Byte(Ord('/')) then
 93                         begin
 94                           _ModuleName:=MarshaledAString(p);
 95                           info^.dli_fname:=MarshaledAString(_ModuleName);
 96                           info^.dli_fbase:=pointer(curbase);
 97                           info^.dli_sname:=nil;
 98                           info^.dli_saddr:=nil;
 99                           Result:=1;
100                         end;
101                       break;
102                     end;
103                 end;
104             end;
105         end;
106     end;
107   Close(F);
108 end;
109 {$ELSE}
110 function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl;
111 begin
112   Result := Posix.Dlfcn.dladdr(UIntPtr(Lib), info^);
113 end;
114 {$ENDIF}
115 {$ENDIF}
116 
117 {$IFDEF POSIX}
118 function GetModuleFileName(hLib: HMODULE):string;
119 var
120   dlinfo: dl_info;
121   IsLib: Boolean;
122 begin
123    if hLib=0 then
124       hLib := HMODULE(@GetModuleFileName);
125 
126     dladdr(pointer(hLib), @dlinfo);
127     Result := UTF8ToString(dlinfo.dli_fname);
128 end;
129 {$ENDIF}