＝^0^＝ 其实他的 demo 已经非常清楚了，这是我以前写的一个例子的片断，包括变量交互、delphi 已有对象封装、自定义类导入等等的使用：
需要整个例子的留下 mail ....
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Menus, uPSComponent, uPSCompiler, uPSRuntime, InterOp;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Compile1: TMenuItem;
MainMenu1: TMainMenu;
Memo1: TMemo;
Memo2: TMemo;
Program1: TMenuItem;
PS3DllPlugin: TPSDllPlugin;
PSScript: TPSScript;
Splitter1: TSplitter;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Compile1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IFPS3ClassesPlugin1CompImport(Sender: TObject;
x: TPSPascalCompiler);
procedure IFPS3ClassesPlugin1ExecImport(Sender: TObject
Exec: TPSExec;
x: TPSRuntimeClassImporter);
procedure PSScriptCompile(Sender: TPSScript);
procedure PSScriptExecute(Sender: TPSScript);
private
FDouValue: Double;
FIntValue: Integer;
FOp: TInterOp;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
uPSUtils,
uPSR_std,
uPSC_std,
uPSR_stdctrls,
uPSC_stdctrls,
uPSR_forms,
uPSC_forms,
uPSC_graphics,
uPSC_controls,
uPSC_classes,
uPSR_graphics,
uPSR_controls,
uPSR_classes,
uPSI_Registry, Registry,
uPSI_IniFiles;
{$R *.DFM}
function ImportTest(S1: string
s2: Longint
s3: Byte
s4: word
var s5: string): string;
begin
Result := s1 + ' ' + IntToStr(s2) + ' ' + IntToStr(s3) + ' ' + IntToStr(s4) + ' - OK!';
S5 := s5 + ' '+ result + ' - OK2!';
end;
procedure MyWriteln(const s: string);
begin
Form1.Memo2.Lines.Add(s);
end;
function MyReadln(const question: string): string;
begin
Result := InputBox(question, '', '');
end;
{ TForm1 }
////////////////////////////////////////////////////////////////////////////////
//设计: Linc 2005.01.05
//功能: 为编译期额外定义 Registry 类，定义 MessageBox 函数
//参数：
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.IFPS3ClassesPlugin1CompImport(Sender: TObject;
x: TIFPSPascalcompiler);
begin
SIRegister_Std(x);
SIRegister_Classes(x, true);
SIRegister_Graphics(x, true);
SIRegister_Controls(x);
SIRegister_stdctrls(x);
SIRegister_Forms(x);
with x do
begin
AddDelphiFunction('Procedure ShowMessage( const Msg : string)');
AddDelphiFunction('Procedure ShowMessagePos( const Msg : string
X, Y : Integer)');
AddDelphiFunction('Function InputBox( const ACaption, APrompt, ADefault : string) : string');
AddDelphiFunction('Function InputQuery( const ACaption, APrompt : string
var Value : string) : Boolean');
AddDelphiFunction('Function PromptForFileName( var AFileName : string
const AFilter : string
const ADefaultExt : string
const ATitle : string
const AInitialDir : string
SaveDialog : Boolean) : Boolean');
end;
SIRegister_Registry(x);
SIRegister_IniFiles(x);
SIRegisterInterOp(x);
end;
////////////////////////////////////////////////////////////////////////////////
//设计: Linc 2005.01.05
//功能: 为运行期映射 Registry 类，MessageBox 函数
//参数：
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.IFPS3ClassesPlugin1ExecImport(Sender: TObject
Exec: TIFPSExec;
x: TIFPSRuntimeClassImporter);
begin
RIRegister_Std(x);
RIRegister_Classes(x, True);
RIRegister_Graphics(x, True);
RIRegister_Controls(x);
RIRegister_stdctrls(x);
RIRegister_Forms(x);
with Exec do
begin
RegisterDelphiFunction(@ShowMessage, 'ShowMessage', cdRegister);
RegisterDelphiFunction(@ShowMessagePos, 'ShowMessagePos', cdRegister);
RegisterDelphiFunction(@InputBox, 'InputBox', cdRegister);
RegisterDelphiFunction(@InputQuery, 'InputQuery', cdRegister);
RegisterDelphiFunction(@PromptForFileName, 'PromptForFileName', cdRegister);
end;
RIRegister_Registry(x);
RIRegister_IniFiles(x);
RIRegisterInterOp(x);
end;
////////////////////////////////////////////////////////////////////////////////
//设计: Linc 2005.01.05
//功能: 定义变量、函数
//参数：
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.PSScriptCompile(Sender: TPSScript);
begin
Sender.AddFunction(@MyWriteln, 'procedure Writeln(s: string);');
Sender.AddFunction(@MyReadln, 'function Readln(question: string): string;');
Sender.AddFunction(@ImportTest, 'function ImportTest(S1: string
s2: Longint
s3: Byte
s4: word
var s5: string): string;');
Sender.AddRegisteredVariable('Application', 'TApplication');
Sender.AddRegisteredVariable('Self', 'TForm');
Sender.AddRegisteredVariable('Memo1', 'TMemo');
Sender.AddRegisteredVariable('Memo2', 'TMemo');
Sender.AddRegisteredVariable('Op', 'TInterOp');
Sender.AddRegisteredVariable('IntValue', 'Integer');
Sender.AddRegisteredPTRVariable('DouValue', 'Double');
end;
////////////////////////////////////////////////////////////////////////////////
//设计: Linc 2005.01.05
//功能: 设置使用的变量
//参数：
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.PSScriptExecute(Sender: TPSScript);
begin
PSScript.SetVarToInstance('APPLICATION', Application);
PSScript.SetVarToInstance('SELF', Self);
PSScript.SetVarToInstance('MEMO1', Memo1);
PSScript.SetVarToInstance('MEMO2', Memo2);
PSScript.SetVarToInstance('Op', FOp);
VSetInt(PSScript.GetVariable('IntValue'), 1234567);
PSScript.SetPointerToData('DouValue', @FDouValue, PSScript.FindBaseType(btDouble));
end;
procedure TForm1.Compile1Click(Sender: TObject);
procedure OutputMessages;
var
l: Longint;
b: Boolean;
begin
b := False;
for l := 0 to PSScript.CompilerMessageCount - 1 do
begin
Memo2.Lines.Add('Compiler: '+ PSScript.CompilerErrorToStr(l));
if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
begin
b := True;
Memo1.SelStart := PSScript.CompilerMessages[l].Pos;
end;
end;
end;
begin
Memo2.Lines.Clear;
PSScript.Script.Assign(Memo1.Lines);
Memo2.Lines.Add('Compiling');
if PSScript.Compile then
begin
OutputMessages;
Memo2.Lines.Add('Compiled succesfully');
if not PSScript.Execute then
begin
Memo1.SelStart := PSScript.ExecErrorPosition;
Memo2.Lines.Add(PSScript.ExecErrorToString +' at '+Inttostr(PSScript.ExecErrorProcNo)+'.'+Inttostr(PSScript.ExecErrorByteCodePosition));
end else Memo2.Lines.Add('Succesfully executed');
end else
begin
OutputMessages;
Memo2.Lines.Add('Compiling failed');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FDouValue := 3.141592653589793;
FIntValue := 123456;
FOp := TInterOp.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FOp);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('/Software/Microsoft/Windows/CurrentVersion/Run', False) then
begin
GetValueNames(Memo2.Lines);
ShowMessage(Memo2.Lines.Text);
CloseKey;
end;
finally
Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage('double value (douvalue): ' + FloatToStr(FDouValue));
ShowMessage('integer value (intvalue): ' + IntToStr(FIntValue));
end;
end.
]