The following is my code:
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 *.开发者_Go百科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 is runtime package contains Unit3.pas.
How to invoke the Get_ProcAddress from the PascalScript?
I get the following error message during compile the script,
[Error] (7:7): Identifier expected
The error you're seeing at the seventh character of the seventh line has nothing to do with Get_ProcAddress
. You have an @
character, and the interpreter tells you it expected an identifier. Double-check the syntax rules for assigning procedure pointers in Pascal Script (keeping in mind that they might not be the same as Delphi's).
You probably need to declare Get_ProcAddress
in your interface
section. Currently it's only in the implementation
.
精彩评论