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.