Delphi脚本语言注入

Delphi不是解释性语言，在很多需要动态维护代码的时候很难处理，自己写一个解释器也不是现有的精力和能力可以完成的，好在Microsoft提供了一个ActiveX组件TScriptControl。这个组件可以完成简单的脚本操作，对VBScript和JavaScript都提供支持。在Delphi中将其加入即可像普通控件一样使用。

下面是一个VBScript的消息框示例：

以下内容为程序代码:

ScriptControl1.Language:='VBScript';

ScriptControl1.ExecuteStatement('MsgBox "Hello, World!"');

下面是一个JavaScript内嵌函数的示例：

以下内容为程序代码:

procedure TForm1.Button3Click(Sender: TObject);

var

n:Integer;

Parameters:PSafeArray;

bound:TSAFEARRAYBOUND;

Index:integer;

v:Variant;

begin

//

try

n:=StrToInt(inputbox('demo','请输入要计算阶乘的数','));

except

ShowMessage('输入有误，必须输入数字，请重新运行');

Exit;

end;

ScriptControl1.Reset;

ScriptControl1.Language:='JScript';

//添加阶乘函数

scriptcontrol1.addCode('function factorial(num){'+

'result=1;for(ix=1;ix<=num;ix++){'+

'result = result*ix;};return result;};');

//参数为一维有一个元素的SafeArray

bound.lLbound:=0;

bound.cElements:=1;

try

Parameters := SafeArrayCreate(VT_VARIANT, 1, bound);

except

ShowMessage('分配内存错误');

Exit;

end;

//因为SafeArrayPutElement的第二个参数定义为const类型，

//所以index必须定义为变量并赋值才能被调用

V:=n;

Index:=0;

SafeArrayPutElement(Parameters,Index,V);

try

ShowMessage(ScriptControl1.Run('factorial',Parameters));

finally

SafeArrayDestroy(Parameters);

end;

end;

下面是一个运行过程中动态加载脚本的示例：

以下内容为程序代码:

(*

function myfunction(param){

/*

if (param == 9)

result = '999';

else

result = '???';

return result;

*/

switch(param){

case 0:

result = '000';

break;

case 9:

result = 'OK';

break;

default:

result = param;

};

return result;

};

*)

procedure TForm1.Button4Click(Sender: TObject);

var

szCode, szCodeTmp, szFunName: string;

Parameters:PSafeArray;

bound:TSAFEARRAYBOUND;

Index:integer;

v:Variant;

n, nPos: integer;

szDefault: string;

begin

szCode:= Memo1.Text;

szDefault:= 'function DefaultFun(){result = '+''Hello,Baby.''+';return result;};';

if szCode = ' then

begin

szCode:= szDefault;

end;

ScriptControl1.Reset;

ScriptControl1.Language:='JScript';

//添加自定义函数

scriptcontrol1.addCode(szCode);

//参数为一维有一个元素的SafeArray

bound.lLbound:=0;

bound.cElements:=1;

try

Parameters := SafeArrayCreate(VT_VARIANT, 1, bound);

except

ShowMessage('分配内存错误');

Exit;

end;

V:=9;

Index:=0;

SafeArrayPutElement(Parameters,Index,V);

nPos:= pos('(', szCode);

szFunName:= copy(szCode, 9, nPos-9);

szFunName:= Trim(szFunName);

try

ShowMessage(ScriptControl1.Run(szFunName,Parameters));

finally

SafeArrayDestroy(Parameters);

end;

end;