home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRPT.ZIP / ifpasscript / libraries / call / ifpsdelphi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-06  |  1.6 KB  |  69 lines
  1. unit ifpsdelphi;
  2.  
  3. interface
  4. uses
  5.   ifpscall, ifspas, ifs_utl, ifs_var;
  6.  
  7. function RegisterDelphiFunction(ScriptEngine: TIfPasScript; const Declaration: String; Address: Pointer): Boolean;
  8.  
  9. {
  10. Valid types for in Declaration:
  11. Byte
  12. Shortint
  13. Word
  14. Smallint
  15. Cardinal
  16. Longint
  17. Integer
  18. PChar (string with EXT param of TypeRec to 1) (*)
  19. String
  20.  
  21. Valid calling conventions:
  22. register (default)
  23. stdcall
  24. cdecl
  25. pascal
  26.  
  27. * Pchar type does not support Var parameter.
  28.  
  29. }
  30.  
  31.  
  32. implementation
  33.  
  34. function DProc(Sender: TIFPasScript; ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  35. begin
  36.   if not InnerfuseCall(Nil, PProcedure(Proc)^._Ext, TCallingConvention(PProcedure(Proc)^._Ext2), Params, Res) then
  37.   begin
  38.     Sender.RunError2(Sender, ECustomError, 'Could not call function');
  39.     DProc := ECustomError;
  40.   end else
  41.     DPRoc := ENoError;
  42. end;
  43.  
  44. function RegisterDelphiFunction(ScriptEngine: TIfPasScript; const Declaration: String; Address: Pointer): Boolean;
  45. var
  46.   FuncName, FuncParam: string;
  47.   cc: TCallingConvention;
  48.   P: PProcedure;
  49. begin
  50.   if not ReadHeader(ScriptEngine, Declaration, FuncName, FuncParam, CC) then
  51.     RegisterDelphiFunction := False
  52.   else begin
  53.     p := ScriptEngine.AddFunction(@dproc, 'procedure '+FuncName+';', Address);
  54.     if assigned(p) then
  55.     begin
  56.       with P^ do
  57.       begin
  58.         _Ext2 := Pointer(CC);
  59.         Decl := FuncParam;
  60.         Name := FuncName;
  61.       end;
  62.       RegisterDelphiFunction := True;
  63.     end else
  64.       RegisterDelphiFunction := False;
  65.   end;
  66. end;
  67.  
  68. end.
  69.