home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d456 / CAJSCRPT.ZIP / ifps3 / ifpidll2runtime.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-06  |  4KB  |  160 lines
  1. unit ifpidll2runtime;
  2.  
  3. {$I ifps3_def.inc}
  4. interface
  5. uses
  6.   ifpicall, ifps3, ifps3utl, ifps3common;
  7. {Register the dll runtime library}
  8. procedure RegisterDLLRuntime(Caller: TIFPSExec);
  9. {Process a dll import (no need to call this function)}
  10. function ProcessDllImport(Caller: TIFPSExec; P: PIFProcRec): Boolean;
  11.  
  12. implementation
  13. uses
  14.   {$IFDEF LINUX}
  15.   LibC;
  16.   {$ELSE}
  17.   Windows;
  18.   {$ENDIF}
  19.  
  20. {
  21. p^.Ext1 contains the pointer to the Proc function
  22. p^.ExportDecl:
  23.   'dll:'+DllName+#0+FunctionName+#0+chr(Cc)+VarParams
  24. }
  25.  
  26. type
  27.   PLoadedDll = ^TLoadedDll;
  28.   TLoadedDll = record
  29.     dllnamehash: Longint;
  30.     dllname: string;
  31.     {$IFDEF LINUX}
  32.     dllhandle: Pointer;
  33.     {$ELSE}
  34.     dllhandle: THandle;
  35.     {$ENDIF}
  36.   end;
  37.  
  38.  
  39. procedure DllFree(Sender: TIFPSExec; P: PLoadedDll);
  40. begin
  41.   {$IFDEF LINUX}
  42.   dlclose(p^.dllhandle);
  43.   {$ELSE}
  44.   FreeLibrary(p^.dllhandle);
  45.   {$ENDIF}
  46.   Dispose(p);
  47. end;
  48.  
  49.  
  50.  
  51. function DllProc(Caller: TIFPSExec; p: PIFProcRec; Global, Stack: TIfList): Boolean;
  52.  
  53. var
  54.   i: Integer;
  55.   MyList: TIfList;
  56.   n: PIFVariant;
  57.   CurrStack: Cardinal;
  58.   cc: TCallingConvention;
  59.   s: string;
  60. begin
  61.   s := p^.ExportDecl;
  62.   delete(S, 1, pos(#0, s));
  63.   delete(S, 1, pos(#0, s));
  64.   if length(S) < 2 then
  65.   begin
  66.     Result := False;
  67.     exit;
  68.   end;
  69.   cc := TCallingConvention(s[1]);
  70.   delete(s, 1, 1);
  71.   CurrStack := Stack.Count - Cardinal(length(s));
  72.   if s[1] = #0 then inc(CurrStack);
  73.   MyList := tIfList.Create;
  74.   for i := 2 to length(s) do
  75.   begin
  76.     MyList.Add(nil);
  77.   end;
  78.   for i := length(s) downto 2 do
  79.   begin
  80.     n :=Stack.GetItem(CurrStack);
  81.     if s[i] <> #0 then
  82.     begin
  83.       n^.RefCount := n^.RefCount or IFPSAddrStackStart;
  84.     end;
  85.     MyList.SetItem(i - 2, n);
  86.     inc(CurrStack);
  87.   end;
  88.   try
  89.     if s[1] <> #0 then
  90.     begin
  91.       n := Stack.GetItem(CurrStack);
  92.     end else n := nil;
  93.     InnerfuseCall(Caller, nil, p^.Ext1, cc, MyList, n, nil);
  94.     result := true;
  95.   except
  96.     result := false;
  97.   end;
  98.   MyList.Free;
  99. end;
  100.  
  101. function ProcessDllImport(Caller: TIFPSExec; P: PIFProcRec): Boolean;
  102. var
  103.   s, s2: string;
  104.   h, i: Longint;
  105.   ph: PLoadedDll;
  106.   {$IFDEF LINUX}
  107.   dllhandle: Pointer;
  108.   {$ELSE}
  109.   dllhandle: THandle;
  110.   {$ENDIF}
  111. begin
  112.   s := p^.ExportDecl;
  113.   Delete(s, 1, 4);
  114.   s2 := copy(s, 1, pos(#0, s)-1);
  115.   delete(s, 1, length(s2)+1);
  116.   h := makehash(s2);
  117.   i := 2147483647; // maxint
  118.   dllhandle := 0;
  119.   repeat
  120.     ph := Caller.FindProcResource2(@dllFree, i);
  121.     if i = -1 then
  122.     begin
  123.       {$IFDEF LINUX}
  124.       dllhandle := dlopen(PChar(s2), RTLD_LAZY);
  125.       {$ELSE}
  126.       dllhandle := LoadLibrary(Pchar(s2));
  127.       {$ENDIF}
  128.       if dllhandle = {$IFDEF LINUX}nil{$ELSE}0{$ENDIF}then
  129.       begin
  130.         Result := False;
  131.         exit;
  132.       end;
  133.       new(ph);
  134.       ph^.dllnamehash := h;
  135.       ph^.dllname := s2;
  136.       ph^.dllhandle := dllhandle;
  137.       Caller.AddResource(@DllFree, ph);
  138.     end;
  139.     if (ph^.dllnamehash = h) and (ph^.dllname = s2) then
  140.     begin
  141.       dllhandle := ph^.dllhandle;
  142.     end;
  143.     dec(i);
  144.   until dllhandle <> {$IFDEF LINUX}nil{$ELSE}0{$ENDIF};
  145.   {$IFDEF LINUX}
  146.   p^.Ext1 := dlsym(dllhandle, pchar(copy(s, 1, pos(#0, s)-1)));
  147.   {$ELSE}
  148.   p^.Ext1 := GetProcAddress(dllhandle, pchar(copy(s, 1, pos(#0, s)-1)));
  149.   {$ENDIF}
  150.   p^.ProcPtr := DllProc;
  151.   Result := p^.Ext1 <> nil;
  152. end;
  153.  
  154. procedure RegisterDLLRuntime(Caller: TIFPSExec);
  155. begin
  156.   Caller.AddSpecialProcImport('dll', @ProcessDllImport, nil);
  157. end;
  158. end.
  159.  
  160.