Question

以下是我的代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uPSComponent;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    FScripter: TPSScript;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.AfterConstruction;
begin
  inherited;
  FScripter := TPSScript.Create(nil);
  (FScripter.Plugins.Add as TPSPluginItem).Plugin := TPSImport_Test.Create(nil);
end;

procedure TForm1.BeforeDestruction;
begin
  inherited;
  while FScripter.Plugins.Count > 0 do
    (FScripter.Plugins.Items[0] as TPSPluginItem).Plugin.Free;
  FScripter.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
  Memo1.Clear;

  FScripter.Script.Text :=
    'var H: Cardinal; '                                     + #13#10 +
    '    P: procedure(const S: string); '                   + #13#10 +
    'begin '                                                + #13#10 +
    '  H := LoadPackage(''Package1.bpl''); '                + #13#10 +
    '  try '                                                + #13#10 +
    '    if H  0 then begin '                             + #13#10 +
    '      @P := Get_ProcAddress(H, ''TestProc''); '        + #13#10 +
    '      P(''12345''); '                                  + #13#10 +
    '    end; '                                             + #13#10 +
    '  finally '                                            + #13#10 +
    '    UnloadPackage(H); '                                + #13#10 +
    '  end; '                                               + #13#10 +
    'end.';

  if FScripter.Compile then begin
    if not FScripter.Execute then
      Memo1.Lines.Text := string(FScripter.ExecErrorToString);
  end else
    for i := 0 to FScripter.CompilerMessageCount - 1 do
      Memo1.Lines.Add(string(FScripter.CompilerMessages[i].MessageToString));
end;

end.

unit Unit2;

interface

uses uPSComponent;

type
  TPSImport_Test = class(TPSPlugin)
  public
    procedure CompileImport1(CompExec: TPSScript); override;
    procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
        override;
  end;


implementation

uses Dialogs, SysUtils, Windows;

function Get_ProcAddress(const aHandle: Cardinal; const aProcName: string):
    Pointer;
begin
  Result := GetProcAddress(aHandle, PChar(aProcName));
end;

procedure TPSImport_Test.CompileImport1(CompExec: TPSScript);
begin
  CompExec.Comp.AddDelphiFunction('procedure ShowMessage(const Msg: string)');
  CompExec.Comp.AddDelphiFunction('function LoadPackage(const Name: string): cardinal');
  CompExec.Comp.AddDelphiFunction('procedure UnloadPackage(const Module: cardinal)');
  CompExec.Comp.AddDelphiFunction('function Get_ProcAddress(const aHandle: cardinal; const aProcName: string): ___Pointer');
end;

procedure TPSImport_Test.ExecImport1(CompExec: TPSScript; const ri:
    TPSRuntimeClassImporter);
begin
  CompExec.Exec.RegisterDelphiFunction(@ShowMessage,      'ShowMessage',      cdRegister);
  CompExec.Exec.RegisterDelphiFunction(@LoadPackage,      'LoadPackage',      cdRegister);
  CompExec.Exec.RegisterDelphiFunction(@UnloadPackage,    'UnloadPackage',    cdRegister);
  CompExec.Exec.RegisterDelphiFunction(@Get_ProcAddress,  'Get_ProcAddress',  cdRegister);
end;

end.

unit Unit3;

interface

implementation

uses Dialogs;

procedure TestProc(const S: string);
begin
  MessageDlg(S, mtInformation, [mbOK], 0);
end;

exports TestProc;

end.

Package1.bpl是运行时包，包含Unit3.pas。

如何从PascalScript调用Get_ProcAddress？

我在编译脚本时收到以下错误消息，

[Error] (7:7): Identifier expected

Answer 1

您可能需要在Get_ProcAddress部分声明interface。目前它只在implementation。

Answer 2

您在第七行的第七个字符处看到的错误与Get_ProcAddress无关。你有一个@字符，解释器告诉你它需要一个标识符。仔细检查在Pascal脚本中分配过程指针的语法规则（请记住它们可能与Delphi不同）。

无法从PascalScript调用Get_ProcAddress

2 个答案: