unit Intf; interface uses SysUtils, Classes, Dialogs; type ITest = interface ['{E7AA427A-0F4D-4A96-A914-FAB1CA336337}'] function GetProp: String; procedure SetProp(Value: String); procedure Proc; overload; procedure Proc(A: Integer); overload; procedure Proc2; cdecl; property Prop: String read GetProp write SetProp; end; TTest = class(TInterfacedObject, ITest) private fStr: String; function GetProp: String; procedure SetProp(Value: String); public constructor Create; destructor Destroy; override; procedure Proc; overload; procedure Proc(A: Integer); overload; procedure Proc2; cdecl; property Prop: String read GetProp write SetProp; end; implementation function TTest.GetProp: String; begin result := fStr; end; procedure TTest.SetProp(Value: String); begin fStr := Value; end; procedure TTest.Proc; begin ShowMessage(fstr); end; procedure TTest.Proc(A: Integer); begin ShowMessage(IntToStr(A)); end; procedure TTest.Proc2; begin ShowMessage('2'); end; constructor TTest.Create; begin fStr := 'abc'; end; destructor TTest.Destroy; begin ShowMessage('Done'); inherited; end; end.
unit IMP_Intf; interface uses SysUtils, Classes, Dialogs, Intf, BASE_SYS, BASE_EXTERN, PaxScripter; procedure RegisterIMP_Intf; implementation procedure TTest_Proc3(MethodBody: TPAXMethodBody); begin with MethodBody do TTest(Self).Proc(); end; procedure TTest_Proc4(MethodBody: TPAXMethodBody); begin with MethodBody do TTest(Self).Proc(Params[0].AsInteger); end; procedure TTest_Proc2(MethodBody: TPAXMethodBody); begin with MethodBody do TTest(Self).Proc2(); end; function TTest__GetProp(Self:TTest):String; begin result := Self.Prop; end; procedure TTest__PutProp(Self:TTest;const Value: String); begin Self.Prop := Value; end; procedure RegisterIMP_Intf; var H: Integer; begin H := RegisterNamespace('Intf', -1); // Begin of interface ITest RegisterInterfaceType('ITest',ITest,'IUnknown',IUnknown,H); RegisterInterfaceMethod(ITest, 'function GetProp: String;'); RegisterInterfaceMethod(ITest, 'procedure SetProp(Value: String);'); RegisterInterfaceMethod(ITest, 'procedure Proc; overload;'); RegisterInterfaceMethod(ITest, 'procedure Proc(A: Integer); overload;'); RegisterInterfaceMethod(ITest, 'procedure Proc2; cdecl;'); RegisterInterfaceProperty(ITest,'property Prop: String read GetProp write SetProp;'); // End of interface ITest // Begin of class TTest RegisterClassType(TTest, H); RegisterMethod(TTest, 'constructor Create;', @TTest.Create); RegisterMethod(TTest, 'destructor Destroy; override;', @TTest.Destroy); RegisterStdMethodEx(TTest,'Proc',TTest_Proc3,0,[typeVARIANT]); RegisterStdMethodEx(TTest,'Proc',TTest_Proc4,1,[typeINTEGER,typeVARIANT]); RegisterStdMethodEx(TTest,'Proc2',TTest_Proc2,0,[typeVARIANT]); RegisterMethod(TTest, 'function TTest__GetProp(Self:TTest):String;', @TTest__GetProp, true); RegisterMethod(TTest, 'procedure TTest__PutProp(Self:TTest;const Value: String);', @TTest__PutProp, true); RegisterProperty(TTest, 'property Prop:String read TTest__GetProp write TTest__PutProp;'); // End of class TTest end; initialization RegisterIMP_Intf; end.
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, BASE_SYS, BASE_PARSER, PaxScripter, PaxPascal, StdCtrls, Intf, IMP_Intf; type TForm1 = class(TForm) Button1: TButton; PaxScripter1: TPaxScripter; PaxPascal1: TPaxPascal; procedure Button1Click(Sender: TObject); procedure PaxScripter1AssignScript(Sender: TPaxScripter); procedure FormCreate(Sender: TObject); private { Private declarations } hostobj: ITest; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses IMP_SysUtils; procedure GetIntf(out Obj: ITest); begin obj := TTest.Create; end; procedure TForm1.Button1Click(Sender: TObject); begin hostobj := TTest.Create; PaxScripter1.Run; end; procedure TForm1.PaxScripter1AssignScript(Sender: TPaxScripter); begin Sender.AddModule('1', 'paxPascal'); Sender.AddCode('1', 'uses SysUtils, Intf;'); Sender.AddCode('1', 'var I: ITest;'); Sender.AddCode('1', 'var X: TTest;'); Sender.AddCode('1', 'procedure P;'); Sender.AddCode('1', 'var L: ITest;'); Sender.AddCode('1', 'begin'); Sender.AddCode('1', ' hostobj.QueryInterface(IUnknown, L);'); Sender.AddCode('1', ' print "RefCount = " + IntToStr(IntfRefCount(hostobj));'); Sender.AddCode('1', ' print "RefCount = " + IntToStr(IntfRefCount(L));'); Sender.AddCode('1', ' hostobj.Proc();'); Sender.AddCode('1', ' hostobj := nil;'); Sender.AddCode('1', ' print "RefCount = " + IntToStr(IntfRefCount(L));'); Sender.AddCode('1', 'end;'); Sender.AddCode('1', 'P();'); Sender.AddCode('1', 'X := TTest.Create;'); Sender.AddCode('1', 'if X.GetInterface(ITest, I) then'); Sender.AddCode('1', 'begin'); Sender.AddCode('1', ' print "RefCount = " + IntToStr(IntfRefCount(I));'); Sender.AddCode('1', ' I.Proc();'); Sender.AddCode('1', ' I.Proc(10);'); Sender.AddCode('1', ' I.Proc2();'); Sender.AddCode('1', ' I.Prop := "pqr";'); Sender.AddCode('1', ' print I.Prop;'); Sender.AddCode('1', 'end;'); end; procedure TForm1.FormCreate(Sender: TObject); begin PaxScripter1.RegisterInterfaceVar('hostobj', @ hostobj, ITest); end; initialization RegisterRoutine('procedure GetIntf(out obj: ITest);', @GetIntf); end.