home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / libraries / call / ifpsdelphi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-10-03  |  2.1 KB  |  84 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.   Defines for this unit:
  31.     D1_DEFCCPPASCAL - Set default calling convention to Pascal.
  32.     D1_DEFCCCDECL - Set default calling convention to Cdecl.
  33.     D1_DEFCCSTDCALL - Set default calling convention to StdCall.
  34.     Else the default Calling Convention is Register.
  35.  
  36. }
  37.  
  38. implementation
  39. const
  40.   DefaultCallingConvention: TCallingConvention =
  41.   {$IFDEF D1_DEFCCPPASCAL}ccPascal;{$ELSE}
  42.   {$IFDEF D1_DEFCCCDECL}ccCdecl;{$ELSE}
  43.   {$IFDEF D1_DEFCCSTDCALL}ccStdcall;{$ELSE}
  44.   ccRegister;
  45.   {$ENDIF}
  46.   {$ENDIF}
  47.   {$ENDIF}
  48.  
  49.   function DProc(Sender: TIFPasScript; ScriptID: Pointer; Proc: PProcedure; Params: PVariableManager; res: PIfVariant): TIfPasScriptError;
  50. begin
  51.   if not InnerfuseCall(Sender, Nil, PProcedure(Proc)^._Ext, TCallingConvention(PProcedure(Proc)^._Ext2), Params, Res) then
  52.   begin
  53.     Sender.RunError2(Sender, ECustomError, 'Could not call function');
  54.     DProc := ECustomError;
  55.   end else
  56.     DPRoc := ENoError;
  57. end;
  58.  
  59. function RegisterDelphiFunction(ScriptEngine: TIfPasScript; const Declaration: String; Address: Pointer): Boolean;
  60. var
  61.   FuncName, FuncParam: string;
  62.   cc: TCallingConvention;
  63.   P: PProcedure;
  64. begin
  65.   if not ReadHeader(ScriptEngine, Declaration, FuncName, FuncParam, CC, DefaultCallingConvention) then
  66.     RegisterDelphiFunction := False
  67.   else begin
  68.     p := ScriptEngine.AddFunction(@dproc, 'procedure '+FuncName+';', Address);
  69.     if assigned(p) then
  70.     begin
  71.       with P^ do
  72.       begin
  73.         _Ext2 := Pointer(CC);
  74.         Decl := FuncParam;
  75.         Name := FuncName;
  76.       end;
  77.       RegisterDelphiFunction := True;
  78.     end else
  79.       RegisterDelphiFunction := False;
  80.   end;
  81. end;
  82.  
  83. end.
  84.