1

这个周末，我从 DWScript SVN 更新了我的代码库。我使用的是 Preview 2.7，现在我使用的是最新的中继版本。

我重新编译了我的应用程序，现在 OnAfterInitUnitTable 不再被触发。实际上 TdwsUnit.InitUnitTable 根本没有被调用。顺便说一句：TDWSunit 是在运行时由代码创建的，然后使用 ExposeRTTI 公开两个类。需要公开每个类的一个实例。

什么是 - 现在 - 触发 OnAfterInitUnitTable 的先决条件？

任何帮助表示赞赏。

编辑：重现的示例代码：

program ExposeTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    SysUtils, Classes, TypInfo,
    dwsRTTIExposer, dwsExprs, dwsComp;

type
    TScriptApplication = class(TPersistent)

    end;

    TTestClass = class(TThread)
    private
        FScript                  : IdwsProgram;
        FDelphiWebScript         : TDelphiWebScript;
        FUnit                    : TdwsUnit;
        FScriptApplication       : TScriptApplication;
        FSuccess                 : Boolean;
        procedure ExposeInstancesAfterInitTable(Sender: TObject);
    public
        constructor Create;
        destructor Destroy; override;
        procedure Execute; override;
    end;

var
    Test : TTestClass;


{ TTestClass }

constructor TTestClass.Create;
begin
    inherited Create(TRUE);
    FScriptApplication              := TScriptApplication.Create;
    FDelphiWebScript                := TDelphiWebScript.Create(nil);
    FUnit                           := TdwsUnit.Create(nil);
    FUnit.UnitName                  := 'Test';
    FUnit.Script                    := FDelphiWebScript;
    FUnit.ExposeRTTI(TypeInfo(TScriptApplication), [eoNoFreeOnCleanup]);
    FUnit.OnAfterInitUnitTable      := ExposeInstancesAfterInitTable;
end;

destructor TTestClass.Destroy;
begin
    FreeAndNil(FScriptApplication);
    FreeAndNil(FUnit);
    FreeAndNil(FDelphiWebScript);
    inherited;
end;

procedure TTestClass.Execute;
begin
    WriteLn('Test 1');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('Unit Test; var I: Integer; I := 0;');
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test 2');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('var I: Integer; I := 0;');
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test Done');
end;

procedure TTestClass.ExposeInstancesAfterInitTable(Sender: TObject);
begin
    FUnit.ExposeInstanceToUnit('Application', 'TScriptApplication', FScriptApplication);
    WriteLn('OnAfterInitUnitTable called');
    FSuccess     := TRUE;
end;

begin
    Test := TTestClass.Create;
    Test.Start;
    Sleep(1000);
    WriteLn('Hit enter to quit');
    ReadLn;
    Test.Free;
end.

EDIt2：其他版本使用 Eric Grange 在下面的答案 1 中的建议显示新问题；

program ExposeTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    SysUtils, Classes, TypInfo,
    dwsRTTIExposer, dwsFunctions, dwsExprs, dwsComp;

type
    TScriptApplication = class(TPersistent)
    published
        procedure Demo;
    end;

    TTestClass = class(TThread)
    private
        FScript                  : IdwsProgram;
        FDelphiWebScript         : TDelphiWebScript;
        FUnit                    : TdwsUnit;
        FScriptApplication       : TScriptApplication;
        FSuccess                 : Boolean;
        procedure ExposeInstancesAfterInitTable(Sender: TObject);
        function NeedUnitHandler(const UnitName   : UnicodeString;
                                 var   UnitSource : UnicodeString): IdwsUnit;
    public
        constructor Create;
        destructor Destroy; override;
        procedure Execute; override;
    end;

var
    Test : TTestClass;


{ TTestClass }

constructor TTestClass.Create;
begin
    inherited Create(TRUE);
    FScriptApplication              := TScriptApplication.Create;
    FDelphiWebScript                := TDelphiWebScript.Create(nil);
    FDelphiWebScript.OnNeedUnit     := NeedUnitHandler;
    FUnit                           := TdwsUnit.Create(nil);
    FUnit.UnitName                  := 'Test';
    FUnit.Script                    := FDelphiWebScript;
    FUnit.ExposeRTTI(TypeInfo(TScriptApplication), [eoNoFreeOnCleanup]);
    FUnit.OnAfterInitUnitTable      := ExposeInstancesAfterInitTable;
end;

destructor TTestClass.Destroy;
begin
    FreeAndNil(FScriptApplication);
    FreeAndNil(FUnit);
    FreeAndNil(FDelphiWebScript);
    inherited;
end;

procedure TTestClass.Execute;
begin
    WriteLn('Test 1');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('Unit Test; var I: Integer; I := 0;');
    WriteLn(FScript.Msgs.AsInfo);
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test 2');
    FSuccess     := FALSE;
    FScript      := FDelphiWebScript.Compile('uses Other;');
    WriteLn(FScript.Msgs.AsInfo);
    if FSuccess then
        WriteLn('   Success')
    else
        WriteLn('   Failure');
    WriteLn('Test Done');
end;

procedure TTestClass.ExposeInstancesAfterInitTable(Sender: TObject);
begin
    FUnit.ExposeInstanceToUnit('Application', 'TScriptApplication', FScriptApplication);
    WriteLn('OnAfterInitUnitTable called');
    FSuccess     := TRUE;
end;

function TTestClass.NeedUnitHandler(
    const UnitName   : UnicodeString;
    var   UnitSource : UnicodeString): IdwsUnit;
begin
    Result := nil;
    if SameText(UnitName, 'Other') then
    UnitSource := 'unit Other;' + #13#10 +
                  'procedure Func;' + #13#10 +
                  'begin' + #13#10 +
                  '  Application.Demo;' + #13#10 +
                  'end;' + #13#10
    else
        UnitSource := '';
end;

{ TScriptApplication }

procedure TScriptApplication.Demo;
begin

end;

begin
    Test := TTestClass.Create;
    Test.Start;
    Sleep(1000);
    WriteLn('Hit enter to quit');
    ReadLn;
    Test.Free;
end.
4

1 回答 1

0

当遇到“单元”作为主程序时，编译器当前假定它只是出于 IDE 目的的编译，即。检查语法错误、构建符号映射、提供建议等，结果程序没有完全初始化。

因此，如果您想编译该单元并制作一个可执行程序，您可以拥有一个类似于以下内容的主程序：

uses Test;

这将编译一个由您的单元组成的程序，可以为其创建执行，可以通过 exec.Info 调用函数，可以实例化类等。

Edit2：对于第二个测试用例，如果“使用测试”，它就可以工作；被添加。为了与 Delphi 完全交叉编译，您还需要接口/实现部分（仅针对脚本时，它们不是必需的）

unit Other;

interface

uses Test;

procedure Func;

implementation

procedure Func;
begin
  Application.Demo;
end;

并且如果使用 $RTTI 指令为方法生成 RTTI，至少使用

{$RTTI EXPLICIT METHODS([vcPublished])}
TScriptApplication = class(TPersistent)
published
    procedure Demo;
end;

否则你会得到一个关于“Demo”找不到的错误。

于 2013-05-31T08:35:40.770 回答