home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d456 / CAJSCRPT.ZIP / ifps3 / ifpidelphiruntime.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-12  |  2KB  |  85 lines
  1. {Delphi function importer (runtime)}
  2. unit ifpidelphiruntime;
  3. {
  4.   Innerfuse Pascal Script Call unit
  5.   You may not copy a part of this unit, only use it as whole, with
  6.   Innerfuse Pascal Script Script Engine.
  7. }
  8. {$I ifps3_def.inc}
  9. interface
  10. uses
  11.   ifpicall, ifps3, ifps3utl, ifps3common;
  12. type
  13.   {The calling convention}
  14.   TDelphiCallingConvention = (cdRegister, cdPascal, CdCdecl, CdStdCall);
  15.  
  16. {Register a delphi function}
  17. procedure RegisterDelphiFunctionR(Se: TIFPSExec; ProcPtr: pointer; const  Name: string; cc: TDelphiCallingConvention);
  18. {
  19.   SE is the Script executer.
  20.   ProcPtr is a pointer to the proc to be called.
  21.   Name is the name of that proc (uppercased).
  22.   CC is the calling convention.
  23.  
  24. }
  25.  
  26. {See source}
  27. {$IFDEF D4PLUS}
  28. var
  29. {$ELSE}
  30. const
  31. {$ENDIF}
  32.   DelphiRPFunc: PResourcePtrSupportFuncs = nil;
  33.  
  34. //  This will be automaticly set when you use ifpiclassruntime.pas.
  35.  
  36.  
  37. implementation
  38.  
  39. function p1(Caller: TIFPSExec; p: PIFProcRec; Global, Stack: TIfList): Boolean;
  40. var
  41.   i: Integer;
  42.   MyList: TIfList;
  43.   n: PIFVariant;
  44.   CurrStack: Cardinal;
  45.   s: string;
  46. begin
  47.   s := P^.ExportDecl;
  48.   if length(s) = 0 then begin Result := False; exit; end;
  49.   CurrStack := Stack.Count - Cardinal(length(s));
  50.   if s[1] = #0 then inc(CurrStack);
  51.   MyList := tIfList.Create;
  52.  
  53.   for i := 2 to length(s) do
  54.   begin
  55.     MyList.Add(nil);
  56.   end;
  57.   for i := length(s) downto 2 do
  58.   begin
  59.     n :=Stack.GetItem(CurrStack);
  60.     if s[i] <> #0 then
  61.     begin
  62.       n^.RefCount := n^.RefCount or IFPSAddrStackStart;
  63.     end;
  64.     MyList.SetItem(i - 2, n);
  65.     inc(CurrStack);
  66.   end;
  67.   try
  68.     if s[1] <> #0 then
  69.     begin
  70.       n := Stack.GetItem(CurrStack);
  71.     end else n := nil;
  72.     result := InnerfuseCall(Caller, nil, p^.Ext1, TCallingconvention(p^.ext2), MyList, n, DelphiRPFunc);
  73.   except
  74.     result := false;
  75.   end;
  76.   MyList.Free;
  77. end;
  78.  
  79. procedure RegisterDelphiFunctionR(Se: TIFPSExec; ProcPtr: pointer; const  Name: string; cc: TDelphiCallingConvention);
  80. begin
  81.   Se.RegisterFunctionName(Name, p1, ProcPtr, Pointer(cc));
  82. end;
  83.  
  84. end.
  85.