当我们在窗体上放置一个控件，在Object Inspector的Events中双击该控件的某个方法时，IDE会自动产生该控件相应的方法声明，形如：
procedure TForm1.Button1Click(Sender: TObject);
begin
|
end;
该声明来自类方法属性声明段的事件构造定义，形如：
TButton = class(TButtonControl)
private
...
public
...
published
property OnClick: TNotifyEvent read .....
...
end;
作为持久性机制的一部分，该类方法将作为RTTI被VMT记录。它将决定该类方法的事件类型、参数个数、参数类型，返回值在以后被如何处理。
说到这里，似乎无关痛痒。事实上，我们真正要说的是，这些信息被记录在哪里，它有什么用？既然它被保存起来了，如何在运行时获得它的原始声明？代码似乎更能说明问题：
// 获取类方法的原始声明
// 用法：GetMethodRefrence2(Button1, 'OnClick');
function GetMethodRefrence2(Sender: TObject; MethodName: ShortString; const Decs: ShortString='.'): string;
type
PParamData = ^TParamData;
TParamData = record // 函数参数的数据结构
Flags: TParamFlags; // 参数传递规则
ParamName: ShortString; // 参数的名称
TypeName: ShortString; // 参数的类型名称
end;
function GetClassTypeInfo(aClass: TObject; const AMethodName: Shortstring; const Kind: TTypeKinds = [tkMethod]): PTypeInfo;
var
ppi : PPropInfo;
begin
Result := nil;
ppi := GetPropInfo(aClass.ClassInfo, AMethodName, Kind);
if ppi <> nil then Result := ppi^.PropType^;
end;
function GetParamFlagsName(AParamFlags: TParamFlags): string;
var
I : Integer;
const
spf : array[TParamFlag] of string
= ('var', 'const', 'array of', 'address', '', 'out');
begin
Result := '';
for I := Integer(pfVar) to Integer(pfOut) do
begin
if I = Integer(pfAddress) then Continue;
if TParamFlag(I) in AParamFlags then
Result := Result + spf[TParamFlag(I)];
//GetEnumName(TypeInfo(TParamFlag), I);
end;
end;
var
ATypeInfo : PTypeInfo;
MethodTypeData : PTypeData;
ParamData : PParamData;
TypeStr : PShortString;
I : Integer;
aOne : string;
begin
Result := '';
if MethodName = '' then exit;
aone := '';
ATypeInfo := GetClassTypeInfo(Sender, MethodName);
if ATypeInfo = nil then exit;
MethodTypeData := GetTypeData(ATypeInfo);
// aone := ATypeInfo^.Name;
if MethodTypeData^.MethodKind = mkFunction then
AppendStr(aone, 'function ' + TWinControl(Sender).Name + Decs + MethodName + '(')
else
Appendstr(aone, 'procedure ' + TWinControl(Sender).Name + Decs + MethodName + '(');
ParamData := PParamData(@MethodTypeData^.ParamList);
for I := 1 to MethodTypeData^.ParamCount do
begin
TypeStr := Pointer(Integer(@ParamData^.ParamName) +
Length(ParamData^.ParamName) + 1);
if pos('array of', GetParamFlagsName(ParamData^.Flags)) > 0 then
aone := aone + trim(Format('%s: %s %s;', [(ParamData^.ParamName),
(GetParamFlagsName(ParamData^.Flags)), TypeStr^]))
else
aone := aone + trim(Format('%s %s: %s;', [(GetParamFlagsName(ParamData^.Flags)),
(ParamData^.ParamName), TypeStr^]));
ParamData := PParamData(Integer(ParamData) + SizeOf(TParamFlags) +
Length(ParamData^.ParamName) + Length(TypeStr^) + 2);
end;
Delete(aone, length(aone), 1);
AppendStr(aone, ')');
if MethodTypeData^.MethodKind = mkFunction then
AppendStr(aone, ': ' + PShortString(ParamData)^);
AppendStr(aone, ';');
Result := aone;
end;
以上代码可以看到，就象所有获取RTTI信息的步骤一样，先通过
ATypeInfo := GetClassTypeInfo(Sender, MethodName);获得指定类Sender的方法MethodName的RTTI信息，再通过 MethodTypeData := GetTypeData(ATypeInfo);获得该方法的类链表数据。
至此，Sender的MethodName所包含的方法类型、参数个数、参数类型、返回值等信息都被MethodTypeData引用了。通过枚举就能从中逐一拿出。
如 Memo1.Text := GetMethodRefrence2(Button1, 'OnClick')得到的返回结果是：
procedure Button1.OnClick(Sender: TObject);
那么，取得这样一个原始声明字符串有什么用呢？
当然，如果你只能一直依赖于Delphi的IDE来编写所有代码，那它将变得毫无意义。而如果你需要并借助运行时支持方法，如常用的ifs3(RemObjects)、FR-RTTI或者你自己构造的RTTI LIB，它将变得有意义而且乐趣无穷。
在后续章节中，我们将以RemObjects和FR为例，讨论如何让它做些有用的事情。
（二）构造自定义扩展函数库
上一节我们谈到，在运行时，我们通过RTTI信息重构了一个类方法的原始声明字符串。这个字符串由Class Name(类名)、Method Name(方法名称)、Param Name(参数名称)、Params Type(参数类型)和返回值类型(如果该方法是一个function)构成。这意味着，如果你使用Remobjects(或ifs3)或FR-RTTI在运行时刻为类增加一个新的方法将成为可能。同时我们可以让一些自定义的procedure/function通过外接插件DLL的形式被调用。
开始之前，假设我们曾接触过早期的ifs或目前的Remobjects和Fastreport-RTTI，而且正在使用它并期待它能做些更加灵活的事情。我们试以RemObjects为例，开始顺着这个思路展开讨论。
RemObjects中的TPSScript是主要的Pascal脚本解释组件，它提供了AddFunction、AddFunctionEx、AddMethod、AddMethodEx等函数，支持我们添加自定义的事件、变量或对象。这两组函数使用上的区别仅在于AddMethod和AddMethodEx函数需要指定方法的所有者(Self)。我们惯用的添加自定义方法如：
function MyFunc1(const i: Integer): Boolean;
begin ... end;
function MyFunc2(const i: Integer): Boolean; stdcall;
begin ... end;
procedure TForm1.Button1Click(Sender: TObject);
begin ... end;
PSScript.AddFunction(@MyFunc1, 'function MyFunc1(const i: Integer): Boolean;');
PSScript.AddFunctionEx(@MyFunc2, 'function MyFunc2(const i: Integer): Boolean;', cdStdcall);
PSScript.AddMethod(Self, @Form1.Button1Click, 'procedure Button1Click(Sender: TObject)');
....
现在，我们已经看到，当我们为动态执行的脚本程序添加这些自定义事件时，我们需要传递事件的原始声明和事件的地址指针，其中，原始声明参数传递了TPSScript脚本解释器所需要的语法定义、参数列表和返回值。这再简单不过了，我们只需要把方法实现的声明代码复制一遍，再粘贴一次即可。是的，但这是因为你把这些代码都写完之后一起编译了，这跟你直接写它的调用事件没有任何区别。如果是这样，我们这种支持动态执行的代码也没有多大的存在意义。我们关心的是，当我们动态地创建一个组件，甚至在为这种频繁地创建动态组件搭建一个窗体设计器的情况下，我们能够灵活地给新创建的组件指定动态运行的代码，就象Delphi-IDE-Designer设计窗体时一样，选中某一个组件就能列出它所有published->property段声明的方法接口，双击便能为它写上代码。而且确保它能真正地按照我们的想法动态地运行起来。
注：RemObjects的使用方法请查阅相关资料；
获取类方法列表及其他的RTTI示例代码附后。
我们有必要先来简单地理一下思路：
1、设计阶段
首先，在你的窗体设计器上放置一个控件(如TButton)时，获得这个控件的类方法列表。OnClick、OnContextPopup、OnDragDrop、OnDragOver...等。
双击某个事件名称，获得这个事件的原始声明。并提供输入代码的内容。
2、保存
窗体文件保存到dfm文件；
脚本内容保存任意文件名，内容如：
program Test;
procedure Button1_Click(Sender: TObject);
begin
Button1.Caption := 'Hello the Button';
end;
begin
Button1.OnClick := @Button1_Click;
end.
这个文件就是PSScript.Script.LoadFromFile(...)需要载入的内容。
OK，现在它已经为PSScript.Execute 动态运行作好了准备。
附：获取类的方法列表
procedure GetMethodsList(aClass: TObject; var List: TStringList);
var
i, NumProps : Integer;
PropList : PPropList;
TypeData : PTypeData;
begin
TypeData := GetTypeData(aClass.ClassInfo);
if TypeData = nil then exit;
if List = nil then List := TStringList.Create;
try
GetMem(PropList, SizeOf(PPropInfo) * TypeData.PropCount);
NumProps := GetPropList(aClass.ClassInfo, [tkMethod], PropList);
for i := 0 to NumProps - 1 do
List.Add(PropList[i]^.Name);//, PropList[i]^.StoredProc);
finally
FreeMem(PropList, SizeOf(PPropInfo) * TypeData.PropCount);
end;
end;
待续....
事隔多日，我们已经在不知不觉中被无情地强加了一岁，我们似乎已经了解了一个作为链表数据RTTI信息被VMT保存的类published方法如何重构它的原始声明，并且假设我们试图或曾经把那些支持RTTI动态调用的运行库(如ifs3/RemObjects/FastReport等)玩成滚瓜但不是很烂熟。而事隔多年之后，当盖茨和艾伦坐在暮色苍茫里追忆当年修改PCDOS的架构变成MSDOS的乐趣时，也许我们也正在为今天所付出的这些毫无用处的折腾懊恼不已，懊恼也罢，乐趣也罢，本来世事如棋一着，争来千古业，流尽六朝春。而唯一令我们折腾不休，乐皮不疲的原因依然是：我愿意，I like it! 我想没有什么比 Liking 着自己的所做所为甚至把它当作生存工具更有趣的事了。
既然这样，我们不妨就这个很久以前便已展开并且无法结束的话题继续聊下去（至少我认为要讲的东东远远超出我所能讲的）。首先，祝我们大家都新年快乐吧。
OK，在不修改RTTI运行库的前提下，我们需要让代码能真正运行起来。事实上，我们要做的工作还有很多。至少是：一、保存创建的组件和代码；二、构造自定义方法；三、构建一个脚本加载类；下面我们逐一讨论。
一、保存创建的组件和代码：
先看看控件和字符串代码的转换过程，当然还有其他保存组件的方法，但从兼容性角度考虑，我们采用与Delphi能识别的方法。
//控件转换为字符串
function ComponentToString(Component: TComponent): string;
var
BinStream : TMemoryStream;
StrStream : TStringStream;
s : string;
begin
BinStream := TMemoryStream.Create;
try
StrStream := TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result := StrStream.DataString;
finally
StrStream.Free;
end;
finally
BinStream.Free;
end;
end;
//字符串转换为控件
function StringToComponent(Value: string; Instance: TComponent): TComponent;
var
StrStream : TStringStream;
BinStream : TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
StrStream.Position := 0;
ObjectTextToBinary(StrStream, BinStream);
BinStream.Position := 0;
Result := BinStream.ReadComponent(Instance);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;
如果你直接调用 ComponentToString(TForm1)，那么整个窗体上所有的控件，包括窗体本身将被全部转换成字符串，正如你在Delphi.IDE中按 View as Text(Alt+F12)一样的效果。
这时，你可以把转换的结果按照你自己的方法来处理保存了。
读入时调用逆过程 StringToComponent....
二、构造自定义方法
这也是我们的组织方法不同于Delphi的地方，在Delphi.IDE中，当我们为Button添加OnClick方法时，IDE的构造结果是：
procedure TForm1.Button1Click(Sender: TObject);
而我们通过前述方法重构出来的原始声明是：
procedure Button1.OnClick(Sender: TObject);
之前，有网友也严肃地提出此问题，但关键在于，让Button1.OnClick真正地被工作起来似乎比看起来是怎样声明重要得多。是的，后者才是ifs3/RO/FR能够识别的表达方式。事实上，编译时，最终还必须将Button1.OnClick转换为 Button1_OnClick，然后在运行时需要重定位方法时，再次转换回来。后续章节会进行详细讲解。
三、构建脚本加载类
以RO为例，此单元描述了一个完整的脚本加载类框架，注意TPSScript各方法的调用次序。详细内容，可参阅RO相关资料。
unit uScriptExecute;
{
RTTI Scripts Executer class for RemObjects'
written by Favinc Haul
http://www.soclead.com
favinc@soclead.com
2006,0122
}
interface
uses
Windows, SysUtils, Classes, Forms, DB, Variants,
uPSComponent, uPSComponent_StdCtrls, uPSComponent_Controls,
uPSComponent_Forms, uPSComponent_DB, uPSComponent_COM,
uPSComponent_Default, uPSCompiler, uPSPreprocessor;
type
TOnOutputMsg = procedure(OutputMsg: string; ErrPos: TPoint) of object;
TExtRegistered = record
Count: Integer;
ModuleName: string;
ProcList, ProcDesc: TStringList;
end;
TPSScriptExecute = class
private
PSDllPlugin: TPSDllPlugin;
PSImport_Classes: TPSImport_Classes;
PSImport_DateUtils: TPSImport_DateUtils;
PSImport_ComObj: TPSImport_ComObj;
PSImport_DB: TPSImport_DB;
PSImport_Forms: TPSImport_Forms;
PSImport_Controls: TPSImport_Controls;
PSImport_StdCtrls: TPSImport_StdCtrls;
xpre: TPSPreProcessor;
FThisForm: TForm;
FScripts, FFunctions, FFunctionExs, FMethods, FOutputMsgs: TStringList;
FErrorPos: TPoint;
FOnOutputMsg: TOnOutputMsg;
FAutoRegisterClass: Boolean;
FPSScript: TPSScript;
FAfterCompile: TNotifyEvent;
FBeforeCompile: TNotifyEvent;
FAfterExecute: TPSEvent;
FSystemScript: string;
FCanSystemScript: Boolean;
FLinesCount: Integer;
FAddTypeData: TExtRegistered;
procedure PSScriptCompile(Sender: TPSScript);
procedure PSScriptExecute(Sender: TPSScript);
procedure PSScriptOnAfterExecute(Sender: TPSScript);
procedure WriteOutputMsg(Sender: TPSPascalCompiler);
procedure WriteOutputText(Msg: string);
procedure CheckAddTypes(comper: TPSPascalCompiler);
procedure FreeAllPlugins;
public
constructor Create(Sender: TForm);
destructor Destroy; override;
procedure LoadFromStream(Script_Mem: TMemoryStream);
procedure LoadFromFile(AFileName: string);
procedure AddFunction(P: Pointer; NameExp: string);
procedure AddFunctionEx(P: Pointer; NameExp: string);
procedure AddFunctionList(FuncList: TStringList);
procedure AddMethod(P: Pointer; NameExp: string);
function Compile: Boolean;
function Execute: Boolean;
procedure AddPlugins(plugClass: Pointer);
function GetProcMethodByName(AMethodName: string): TMethod; virtual;
function MethodExists(AMethodName: string): Boolean; virtual;
function ClassExists(AClassName: string): Boolean; virtual;
function ExecFunction(const AParams: array of Variant; const AProcName: string): Variant; virtual;
procedure ReAllocateMethods(MethodList: TStringList); virtual;
property PSScript: TPSScript read FPSScript write FPSScript;
property AutoRegisterClass: Boolean read FAutoRegisterClass write FAutoRegisterClass;
property CanSystemScript: Boolean read FCanSystemScript write FCanSystemScript;
property ThisForm: TForm read FThisForm write FThisForm;
property SystemScript: string read FSystemScript write FSystemScript;
property Scripts: TStringList read FScripts write FScripts;
property Functions: TStringList read FFunctions write FFunctions;
property FunctionExs: TStringList read FFunctionExs write FFunctionExs;
property Methods: TStringList read FMethods write FMethods;
property AddTypeData: TExtRegistered read FAddTypeData write FAddTypeData;
property OutputMsgs: TStringList read FOutputMsgs write FOutputMsgs;
property ErrorPos: TPoint read FErrorPos write FErrorPos;
property LinesCount: Integer read FLinesCount write FLinesCount;
property OnOutputMsg: TOnOutputMsg read FOnOutputMsg write FOnOutputMsg;
property BeforeCompile: TNotifyEvent read FBeforeCompile write FBeforeCompile;
property AfterCompile: TNotifyEvent read FAfterCompile write FAfterCompile;
property AfterExecute: TPSEvent read FAfterExecute write FAfterExecute;
end;
implementation
uses uPSDebugger, uPSUtils, StrUtils, typInfo, uCommonFunc, StdCtrls;
constructor TPSScriptExecute.Create(Sender: TForm);
begin
FAutoRegisterClass := True;
FCanSystemScript := True;
FLinesCount := 0;
FThisForm := Sender;
FScripts := TStringList.Create;
FFunctions := TStringList.Create;
FFunctionExs := TStringList.Create;
FMethods := TStringList.Create;
FOutputMsgs := TStringList.Create;
xpre := TPSPreProcessor.Create;
FPSScript := TPSScript.Create(nil);
// create Plunins object
PSDllPlugin := TPSDllPlugin.Create(nil);
PSImport_Classes := TPSImport_Classes.Create(nil);
PSImport_DateUtils := TPSImport_DateUtils.Create(nil);
PSImport_ComObj := TPSImport_ComObj.Create(nil);
PSImport_DB := TPSImport_DB.Create(nil);
PSImport_Forms := TPSImport_Forms.Create(nil);
PSImport_Controls := TPSImport_Controls.Create(nil);
PSImport_StdCtrls := TPSImport_StdCtrls.Create(nil);
// add pluginItem to plugins list
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_Classes;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_Controls;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_StdCtrls;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_Forms;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSDllPlugin;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_DateUtils;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_ComObj;
TPSPluginItem.Create(FPSScript.Plugins).Plugin := PSImport_DB;
FPSScript.OnAfterExecute := PSScriptOnAfterExecute;
FPSScript.OnCompile := PSScriptCompile;
FPSScript.OnExecute := PSScriptExecute;
// FPSScript.Script := FScripts;
end;
destructor TPSScriptExecute.Destroy;
begin
FreeAllPlugins;
FreeAndNil(xpre);
FreeAndNil(FPSScript);
FreeAndNil(FScripts);
FreeAndNil(FFunctions);
FreeAndNil(FFunctionExs);
FreeAndNil(FMethods);
FreeAndNil(FOutputMsgs);
inherited Destroy;
end;
procedure TPSScriptExecute.AddPlugins(PlugClass: Pointer);
begin
TPSPluginItem.Create(FPSScript.Plugins).Plugin := TPSPlugin(PlugClass);
end;
procedure TPSScriptExecute.FreeAllPlugins;
var
i : Integer;
begin
for i := FPSScript.Plugins.Count - 1 downto 0 do
begin
PSScript.Plugins.Items[i].Free;
end;
end;
procedure TPSScriptExecute.AddFunction(P: Pointer; NameExp: string);
begin
FFunctions.AddObject(NameExp, P);
end;
procedure TPSScriptExecute.AddFunctionEx(P: Pointer; NameExp: string);
begin
FFunctionExs.AddObject(NameExp, P);
end;
procedure TPSScriptExecute.AddMethod(P: Pointer; NameExp: string);
begin
FMethods.AddObject(NameExp, P);
end;
procedure TPSScriptExecute.CheckAddTypes(comper: TPSPascalCompiler);
function ParseTypeStr(sType: string; sec: Integer): string;
var p : Integer;
begin
Result := '';
p := pos('=', sType);
if p <> 0 then
if Bool(sec) then
begin
Result := trim(Copy(sType, p + 1, Length(sType) - p));
if Result[Length(Result)] = ';' then
system.Delete(Result, Length(Result), 1);
end else
Result := trim(LeftStr(sType, p - 1));
end;
var
i : Integer;
sType, sTypeName, sTypeDecl : string;
begin
if FAddTypeData.Count > 0 then
with FAddTypeData do
for i := 0 to Count - 1 do
begin
sType := ProcList.Strings[i];
sTypeName := sType;
sTypeDecl := ProcDesc.Strings[i];
if sTypeDecl = '' then //方法1注册的类型
begin
sTypeName := ParseTypeStr(sType, 0);
sTypeDecl := ParseTypeStr(sType, 1);
end;
comper.AddTypeS(sTypeName, sTypeDecl);
end;
end;
// oncompiling
procedure TPSScriptExecute.PSScriptCompile(Sender: TPSScript);
var
i : Integer;
AClassName : string;
begin
try
Sender.AddRegisteredVariable('Application', 'TApplication');
Sender.AddRegisteredVariable('Self', 'TForm');
Sender.AddRegisteredVariable('MainForm', 'TForm');
Sender.AddRegisteredVariable('This', 'TForm');
if FThisForm <> nil then
Sender.AddRegisteredVariable(FThisForm.Name, 'TForm');
// add custom Type
CheckAddTypes(Sender.Comp);
// add custom functions
with FFunctions do
for i := 0 to Count - 1 do
Sender.AddFunction(Objects[i], Strings[i]);
// add custom functions Ex
with FFunctionExs do
for i := 0 to Count - 1 do
Sender.AddFunctionEx(Objects[i], Strings[i], cdStdcall);
// add custom methos
with FMethods do
for i := 0 to Count - 1 do
Sender.AddMethod(FThisForm, Objects[i], Strings[i]);
// auto register all components by this form
if (FThisForm <> nil) and FAutoRegisterClass then
with FThisForm do
for i := 0 to ComponentCount - 1 do
begin
AClassName := Components[i].ClassName;
if Components[i].InheritsFrom(TDataSet) then
AClassName := 'TDataSet';
if Sender.Comp.FindClass(AClassName) <> nil then
Sender.AddRegisteredVariable(Components[i].Name, AClassName);
end else
begin
//!!!
end;
finally
end;
end;
// onexecuting
procedure TPSScriptExecute.PSScriptExecute(Sender: TPSScript);
var
i : Integer;
begin
Sender.SetVarToInstance('APPLICATION', Application);
Sender.SetVarToInstance('SELF', FThisForm);
Sender.SetVarToInstance('This', FThisForm);
Sender.SetVarToInstance('MainForm', Application.MainForm);
if FThisForm <> nil then
begin
Sender.SetVarToInstance(FThisForm.Name, FThisForm);
with FThisForm do
for i := 0 to ThisForm.ComponentCount - 1 do
Sender.SetVarToInstance(Components[i].Name, Components[i]);
end;
end;
procedure TPSScriptExecute.PSScriptOnAfterExecute(Sender: TPSScript);
begin
end;
// output compiled or executed message
procedure TPSScriptExecute.WriteOutputText(Msg: string);
begin
FOutputMsgs.Add(msg);
if Assigned(FOnOutputMsg) then FOnOutputMsg(Msg, FErrorPos);
end;
// make output message
procedure TPSScriptExecute.WriteOutputMsg(Sender: TPSPascalCompiler);
var
l : Longint;
b : Boolean;
begin
b := False;
for l := 0 to Sender.MsgCount - 1 do
begin
// if (not b) and (Sender.Msg[l] is TPSPascalCompilerError) then
begin
b := True;
// Sender.Msg[l].
Sender.Msg[l].Row := Sender.Msg[l].Row - (PSScript.Script.Count - FLinesCount);
FErrorPos := Point(Sender.Msg[l].Col, Sender.Msg[l].Row);
end;
WriteOutputText(Sender.Msg[l].MessageToString);
end;
end;
//*** compile
function TPSScriptExecute.Compile: Boolean;
begin
Result := False;
FErrorPos := Point(1, 1);
FOutputMsgs.Clear;
if FScripts.Text = '' then exit;
FLinesCount := FScripts.Count;
if Assigned(FBeforeCompile) then FBeforeCompile(PSSCript);
if FCanSystemScript then
if FSystemScript <> '' then
FPSScript.Script.Text := FSystemScript;
if FScripts.Text <> '' then
FPSScript.Script.AddStrings(FScripts);
// FPSScript.Script.Text := FScripts.Text;
Result := FPSScript.Compile;
if Result then
begin
if Assigned(FAfterCompile) then FAfterCompile(PSSCript);
WriteOutputText('编译完成!');
end
else
begin
WriteOutputText('编译失败！');
xpre.AdjustMessages(FPSScript.Comp);
WriteOutputMsg(FPSScript.Comp);
end;
FScripts.Clear;
end;
//*** execute
function TPSScriptExecute.Execute: Boolean;
begin
Result := Compile and FPSScript.Execute;
if Result then
WriteOutputText('脚本运行成功!')
else
WriteOutputText('运行时错误！');
end;
procedure TPSScriptExecute.LoadFromFile(AFileName: string);
begin
if FileExists(AFileName) then
Scripts.LoadFromFile(AFileName);
end;
procedure TPSScriptExecute.LoadFromStream(Script_Mem: TMemoryStream);
begin
if Script_Mem <> nil then
begin
Script_Mem.Position := 0;
Scripts.LoadFromStream(Script_Mem);
end;
end;
function TPSScriptExecute.GetProcMethodByName(AMethodName: string): TMethod;
begin
Result := FPSScript.GetProcMethod(AMethodName);
end;
function TPSScriptExecute.ExecFunction(const AParams: array of Variant;
const AProcName: string): Variant;
begin
if MethodExists(AProcName) then
Result := FPSScript.ExecuteFunction(AParams, AProcName)
end;
function TPSScriptExecute.MethodExists(AMethodName: string): Boolean;
begin
Result := FPSScript.Exec.GetProc(AMethodName) <> InvalidVal;
end;
function TPSScriptExecute.ClassExists(AClassName: string): Boolean;
begin
Result := PSSCript.Comp.FindClass(AClassName) <> nil;
end;
procedure TPSScriptExecute.AddFunctionList(FuncList: TStringList);
begin
FFunctions.AddStrings(FuncList);
end;
//重新指定窗体事件
procedure TPSScriptExecute.ReAllocateMethods(MethodList: TStringList);
var
i : Integer;
s, c, p : string;
m : TMethod;
iFind : TComponent;
begin
for i := 0 to MethodList.Count - 1 do
begin
s := MethodList.Strings[i];
if not ParseCP(s, c, p) then exit;
m := GetProcMethodByName(c + '_' + p);
if m.Code = nil then exit;
iFind := FThisForm.FindComponent(c);
if iFind <> nil then
SetMethodProp(iFind, p, m) else
SetMethodProp(FThisForm, p, m);
end;
end;
end.
现在，通过以下的代码来执行我们自定义的代码：
with TPSScriptExecute.Create(Owner) do
try
PSScript.Add(...);
Functions.Add(....)
FunctionExs.Add(...);
Methods.Add(...);
Execute;
{ Compile; Execute}
finally
Free;
end;
Owner: 所有者，例如窗体 Form1。
PSScript: 脚本代码
Functions: 自定义函数
FunctionExs: 扩展自定义函数
Methods: 自定义方法
Compile: 调用编译过程
Execute: 调用运行过程
至此，我们已经大略掌握了通过RO执行自定义方法和代码的过程了。由于我一再认为你对ifs3/RO/FR比较熟悉，而如果我的假设没错，你看到了这里，那么，至少你是一个已经对RO等核心库感兴趣的人了。所以，具体的细节便不再赘述。
后续章节中，我们开始接触如何在一个窗体中内嵌脚本运行器和如何构造一个自己的窗体设计器。让我们真正拥有一个能够工作起来的小小架构，麻雀虽小，但五官仍是俱全。
569
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
