转 Delphi和JavaScript互通

procedureTForm1.FormCreate(Sender: TObject);

begin

Fscript := CreateScriptControl();

// 把Form1当成一个对象添加到Script中

Fscript.AddObject(Self.Name, SA(Self),true);

Fscript.AddCode('function Form1_OnMouseMove(Sender, shift, x, y)'//

+'{'// 在JS里面直接调用Form1上的任何Public的东西就都可以了,JS里面几乎没有类型的概念.事件的参数随便.计算也随便

+'Form1.Button1.Caption = "x:"+x+";"+"y:"+y +";" + "shift:" + shift;'//

+'}'//

+'function Button1_Click(Sender)'//

+'{'//调用Delphi对象的方法

+'Form1.SetBounds(0,0,800,480);'//

+'}'//

);

//关联Delphi的事件到JS的函数

Self.OnMouseMove := TEventDispatch.Create<TMouseMoveEvent>(Self, Fscript,

'Form1_OnMouseMove');

Button1.OnClick := TEventDispatch.Create<TNotifyEvent>(Button1, Fscript,

'Button1_Click');

end;

{

让Delphi使用windows自带的scriptcontrol,在javascript中可以调用delphi的对象,

并且可以使用事件.

wr960204武稀松 2013

}

unitScriptObjectUtilsWithRTTI;

interface

{

是否使用外部的MSScriptControl_TLB单元.我把这个单元的接口声明都放在后面了,

可以避免引入ActiveX等单元

如果觉得我的声明太旧或者有问题,可以打开这个开关,使用外部自己Import生成的单元

}

{ .$DEFINE Use_External_TLB }

{ 这个开关是使用LoadLibrary方式加载COM DLL,也就及时COM组件没有注册也可以创建COM对象 }

{$DEFINE COMOBJ_FROMDLL}

uses

{$IFDEF Use_External_TLB}

MSScriptControl_TLB,

{$ENDIF}

System.ObjAuto,

System.Classes, System.RTTI, System.Variants,

Winapi.Windows, Winapi.ActiveX, System.TypInfo;

type

{$REGION 'MSScriptControl_TLB'}

{$IFDEF Use_External_TLB}

IScriptControl = MSScriptControl_TLB.IScriptControl;

{$ELSE}

ScriptControlStates = TOleEnum;

IScriptModuleCollection = IDispatch;

IScriptError = IDispatch;

IScriptProcedureCollection = IDispatch;

IScriptControl =interface(IDispatch)

['{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}']

functionGet_Language:WideString; safecall;

procedureSet_Language(constpbstrLanguage:WideString); safecall;

functionGet_State: ScriptControlStates; safecall;

procedureSet_State(pssState: ScriptControlStates); safecall;

procedureSet_SitehWnd(phwnd:Integer); safecall;

functionGet_SitehWnd:Integer; safecall;

functionGet_Timeout:Integer; safecall;

procedureSet_Timeout(plMilleseconds:Integer); safecall;

functionGet_AllowUI: WordBool; safecall;

procedureSet_AllowUI(pfAllowUI: WordBool); safecall;

functionGet_UseSafeSubset: WordBool; safecall;

procedureSet_UseSafeSubset(pfUseSafeSubset: WordBool); safecall;

functionGet_Modules: IScriptModuleCollection; safecall;

functionGet_Error: IScriptError; safecall;

functionGet_CodeObject: IDispatch; safecall;

functionGet_Procedures: IScriptProcedureCollection; safecall;

procedure_AboutBox; safecall;

procedureAddObject(constName:WideString;constObject_: IDispatch;

AddMembers: WordBool); safecall;

procedureReset; safecall;

procedureAddCode(constCode:WideString); safecall;

functionEval(constExpression:WideString): OleVariant; safecall;

procedureExecuteStatement(constStatement:WideString); safecall;

functionRun(constProcedureName:WideString;varParameters: PSafeArray)

: OleVariant; safecall;

propertyLanguage:WideStringread Get_LanguagewriteSet_Language;

propertyState: ScriptControlStates read Get_StatewriteSet_State;

propertySitehWnd:Integerread Get_SitehWndwriteSet_SitehWnd;

propertyTimeout:Integerread Get_TimeoutwriteSet_Timeout;

propertyAllowUI: WordBool read Get_AllowUIwriteSet_AllowUI;

propertyUseSafeSubset: WordBool read Get_UseSafeSubset

writeSet_UseSafeSubset;

propertyModules: IScriptModuleCollection read Get_Modules;

propertyError: IScriptError read Get_Error;

propertyCodeObject: IDispatch read Get_CodeObject;

propertyProcedures: IScriptProcedureCollection read Get_Procedures;

end;

{$ENDIF}

{$ENDREGION 'MSScriptControl_TLB'}

{ 事件代理的泛型类,可以把Delphi的事件映射到Javascript的函数上.

注意,这是一个TComponent的派生类.如果不指定Ownder的话要手工释放的.

}

TEventDispatch =class(TComponent)

private

FScriptControl: IScriptControl;

FScriptFuncName:string;

FInternalDispatcher: TMethod;

FRttiContext: TRttiContext;

FRttiType: TRttiMethodType;

procedureInternalInvoke(Params: PParameters; StackSize:Integer);

functionValueToVariant(Value: TValue): Variant;

constructorCreate(AOwner: TComponent; ATTypeInfo: PTypeInfo);

reintroduce; overload;

public

classfunctionCreate<T>(AOwner: TComponent; ScriptControl: IScriptControl;

ScriptFuncName:String): T; reintroduce; overload;

destructorDestroy; override;

end;

{ 很普通,创建一个MSWindows自带的ScriptControl实例,默认脚本是Javascript }

functionCreateScriptControl(ScriptName:String='javascript'): IScriptControl;

{ 创建对象的IDispatch的代理, Owned表示这个IDispatch拥有代理对象的生杀大权,当代理的IDispatch

释放的时候这个Obj也会被释放掉 }

functionSA(Obj: TObject; Owned:Boolean): IDispatch; overload;

{ 创建对象的IDispatch的代理 }

functionSA(Obj: TObject): IDispatch; overload;

implementation

uses

{$IFNDEF COMOBJ_FROMDLL}

System.Win.ComObj,

{$ENDIF}

System.SysUtils;

functionCreateScriptControl(ScriptName:String): IScriptControl;

const

CLASS_ScriptControl: TGUID ='{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}';

{$IFDEF COMOBJ_FROMDLL}

MSSCRIPTMODULE ='msscript.ocx';

var

DllGetClassObject:function(constclsid, IID: TGUID;varObj)

: HRESULT; stdcall;

ClassFactory: IClassFactory;

hLibInst: HMODULE;

hr: HRESULT;

begin

Result :=nil;

hLibInst := GetModuleHandle(MSSCRIPTMODULE);

ifhLibInst =0then

hLibInst := LoadLibrary(MSSCRIPTMODULE);

ifhLibInst =0then

Exit;

DllGetClassObject := GetProcAddress(hLibInst,'DllGetClassObject');

ifAssigned(DllGetClassObject)then

begin

hr := DllGetClassObject(CLASS_ScriptControl, IClassFactory, ClassFactory);

ifhr = S_OKthen

begin

hr := ClassFactory.CreateInstance(nil, IScriptControl, Result);

if(hr = S_OK)and(Result <>nil)then

Result.Language := ScriptName;

end;

end;

end;

{$ELSE}

begin

Result := CreateComObject(CLASS_ScriptControl)asIScriptControl;

ifResult <>nilthen

Result.Language := ScriptName;

end;

{$ENDIF}

type

TDispatchKind = (dkMethod, dkProperty, dkSubComponent);

TDispatchInfo =record

Instance: TObject;

caseKind: TDispatchKindof

dkMethod:

(MethodInfo: TRttiMethod);

dkProperty:

(PropInfo: TRttiProperty);

dkSubComponent:

(ComponentInfo: NativeInt);

end;

TDispatchInfos =arrayofTDispatchInfo;

{

IDispatch代理类.通过RTTI可以把Delphi对象的成员/属性/函数映射给IDispatch.

而且忽略调用协议.

}

TScriptObjectAdapter =class(TInterfacedObject, IDispatch)

private

//

FRttiContext: TRttiContext;

FRttiType: TRttiType;

FDispatchInfoCount:Integer;

FDispatchInfos: TDispatchInfos;

FComponentNames: TStrings;

FInstance: TObject;

FOwned:Boolean;

functionAllocDispID(AKind: TDispatchKind; Value:Pointer;

AInstance: TObject): TDispID;

protected

propertyInstance: TObject read FInstance;

public

{ IDispatch }

functionGetIDsOfNames(constIID: TGUID; Names:Pointer; NameCount:Integer;

LocaleID:Integer; DispIDs:Pointer): HRESULT; virtual; stdcall;

functionGetTypeInfo(Index:Integer; LocaleID:Integer; out TypeInfo)

: HRESULT; stdcall;

functionGetTypeInfoCount(out Count:Integer): HRESULT; stdcall;

functionInvoke(DispID:Integer;constIID: TGUID; LocaleID:Integer;

Flags:Word;varParams; VarResult:Pointer; ExcepInfo:Pointer;

ArgErr:Pointer): HRESULT; virtual; stdcall;

public

constructorCreate(Instance: TObject; Owned:Boolean=False);

destructorDestroy; override;

end;

functionSA(Obj: TObject; Owned:Boolean): IDispatch;

begin

Result := TScriptObjectAdapter.Create(Obj, Owned);

end;

functionSA(Obj: TObject): IDispatch;

begin

Result := TScriptObjectAdapter.Create(Obj,False);

end;

const

ofDispIDOffset =100;

{ TScriptObjectAdapter }

functionTScriptObjectAdapter.AllocDispID(AKind: TDispatchKind; Value:Pointer;

AInstance: TObject): TDispID;

var

I:Integer;

dispatchInfo: TDispatchInfo;

begin

forI := FDispatchInfoCount -1downto0do

withFDispatchInfos[I]do

if(Kind = AKind)and(MethodInfo = Value)then

begin

// Already have a dispid for this methodinfo

Result := ofDispIDOffset + I;

Exit;

end;

ifFDispatchInfoCount = Length(FDispatchInfos)then

SetLength(FDispatchInfos, Length(FDispatchInfos) +10);

Result := ofDispIDOffset + FDispatchInfoCount;

withdispatchInfodo

begin

Instance := AInstance;

Kind := AKind;

MethodInfo := Value;

end;

FDispatchInfos[FDispatchInfoCount] := dispatchInfo;

Inc(FDispatchInfoCount);

end;

constructorTScriptObjectAdapter.Create(Instance: TObject; Owned:Boolean);

begin

inheritedCreate;

FComponentNames := TStringList.Create;

FInstance := Instance;

FOwned := Owned;

FRttiContext := TRttiContext.Create;

FRttiType := FRttiContext.GetType(FInstance.ClassType);

end;

destructorTScriptObjectAdapter.Destroy;

begin

ifFOwnedthen

FInstance.Free;

FRttiContext.Free;

FComponentNames.Free;

inheritedDestroy;

end;

functionTScriptObjectAdapter.GetIDsOfNames(constIID: TGUID; Names:Pointer;

NameCount, LocaleID:Integer; DispIDs:Pointer): HRESULT;

type

PNames = ^TNames;

TNames =array[0..100]ofPOleStr;

PDispIDs = ^TDispIDs;

TDispIDs =array[0..100]ofCardinal;

var

Name:String;

MethodInfo: TRttiMethod;

PropertInfo: TRttiProperty;

ComponentInfo: TComponent;

lDispId: TDispID;

begin

Result := S_OK;

lDispId := -1;

Name := WideCharToString(PNames(Names)^[0]);

MethodInfo := FRttiType.GetMethod(Name);

// MethodInfo.Invoke(FInstance, ['']);

ifMethodInfo <>nilthen

begin

lDispId := AllocDispID(dkMethod, MethodInfo, FInstance);

end

else

begin

PropertInfo := FRttiType.GetProperty(Name);

ifPropertInfo <>nilthen

begin

lDispId := AllocDispID(dkProperty, PropertInfo, FInstance);

end

elseifFInstanceisTComponentthen

begin

ComponentInfo := TComponent(FInstance).FindComponent(Name);

ifComponentInfo <>nilthen

begin

lDispId := AllocDispID(dkSubComponent,Pointer(FComponentNames.Add(Name)

), FInstance);

end;

end;

end;

iflDispId >= ofDispIDOffsetthen

begin

Result := S_OK;

PDispIDs(DispIDs)^[0] := lDispId;

end;

end;

functionTScriptObjectAdapter.GetTypeInfo(Index, LocaleID:Integer;

out TypeInfo): HRESULT;

begin

Result := E_NOTIMPL;

end;

functionTScriptObjectAdapter.GetTypeInfoCount(out Count:Integer): HRESULT;

begin

Result := E_NOTIMPL;

end;

functionTScriptObjectAdapter.Invoke(DispID:Integer;constIID: TGUID;

LocaleID:Integer; Flags:Word;varParams;

VarResult, ExcepInfo, ArgErr:Pointer): HRESULT;

type

PVariantArray = ^TVariantArray;

TVariantArray =array[0..65535]ofVariant;

PIntegerArray = ^TIntegerArray;

TIntegerArray =array[0..65535]ofInteger;

var

Parms: PDispParams;

TempRet: Variant;

dispatchInfo: TDispatchInfo;

lParams: TArray<TValue>;

paramInfos: TArray<TRttiParameter>;

I:Integer;

component: TComponent;

propertyValue: TValue;

_SetValue: NativeInt;

tmpv: Variant;

begin

Result := S_OK;

Parms := @Params;

try

ifVarResult =nilthen

VarResult := @TempRet;

if(DispID - ofDispIDOffset >=0)and

(DispID - ofDispIDOffset < FDispatchInfoCount)then

begin

dispatchInfo := FDispatchInfos[DispID - ofDispIDOffset];

casedispatchInfo.Kindof

dkProperty:

begin

ifFlagsand(DISPATCH_PROPERTYPUTREForDISPATCH_PROPERTYPUT) <>0

then

if(Parms.cNamedArgs <>1)or

(PIntegerArray(Parms.rgdispidNamedArgs)^[0] <>

DISPID_PROPERTYPUT)then

Result := DISP_E_MEMBERNOTFOUND

else

begin

propertyValue := TValue.Empty;

casedispatchInfo.PropInfo.PropertyType.Handle^.Kindof

tkInt64, tkInteger:

propertyValue :=

TValue.FromOrdinal

(dispatchInfo.PropInfo.PropertyType.Handle,

PVariantArray(Parms.rgvarg)^[0]);

tkFloat:

propertyValue := TValue.From<Extended>

(PVariantArray(Parms.rgvarg)^[0]);

tkString, tkUString, tkLString, tkWString:

propertyValue :=

TValue.From<String>(PVariantArray(Parms.rgvarg)^[0]);

tkSet:

begin

_SetValue := PVariantArray(Parms.rgvarg)^[0];

TValue.Make(_SetValue,

dispatchInfo.PropInfo.PropertyType.Handle,

propertyValue);

end;

else

propertyValue :=

TValue.FromVariant(PVariantArray(Parms.rgvarg)^[0]);

end;

dispatchInfo.PropInfo.SetValue(dispatchInfo.Instance,

propertyValue);

end

elseifParms.cArgs <>0then

Result := DISP_E_BADPARAMCOUNT

elseifdispatchInfo.PropInfo.PropertyType.Handle^.Kind = tkClass

then

POleVariant(VarResult)^ :=

SA(dispatchInfo.PropInfo.GetValue(dispatchInfo.Instance)

.AsObject())asIDispatch

else

POleVariant(VarResult)^ := dispatchInfo.PropInfo.GetValue

(dispatchInfo.Instance).AsVariant;

end;

dkMethod:

begin

paramInfos := dispatchInfo.MethodInfo.GetParameters;

SetLength(lParams, Length(paramInfos));

forI := Low(paramInfos)toHigh(paramInfos)do

ifI < Parms.cArgsthen

begin

//因为IDispatch是COM对象,一般是stdcall或者safecall,参数是由右到左传递的

tmpv := PVariantArray(Parms.rgvarg)^[Parms.cArgs -1- I];

lParams[I] := TValue.FromVariant(tmpv);

end

else//不足的参数补空

begin

TValue.Make(0, paramInfos[I].ParamType.Handle, lParams[I]);

end;

if(dispatchInfo.MethodInfo.ReturnType <>nil)and

(dispatchInfo.MethodInfo.ReturnType.Handle^.Kind = tkClass)then

begin

POleVariant(VarResult)^ :=

SA(dispatchInfo.MethodInfo.Invoke(dispatchInfo.Instance,

lParams).AsObject())asIDispatch;

end

else

begin

POleVariant(VarResult)^ := dispatchInfo.MethodInfo.Invoke

(dispatchInfo.Instance, lParams).AsVariant();

end;

end;

dkSubComponent:

begin

component := TComponent(dispatchInfo.Instance)

.FindComponent(FComponentNames[dispatchInfo.ComponentInfo]);

ifcomponent =nilthen

Result := DISP_E_MEMBERNOTFOUND;

POleVariant(VarResult)^ := SA(component)asIDispatch;

end;

end;

end

else

Result := DISP_E_MEMBERNOTFOUND;

except

ifExcepInfo <>nilthen

begin

FillChar(ExcepInfo^, SizeOf(TExcepInfo),0);

withTExcepInfo(ExcepInfo^)do

begin

bstrSource := StringToOleStr(ClassName);

ifExceptObjectisExceptionthen

bstrDescription := StringToOleStr(Exception(ExceptObject).Message);

scode := E_FAIL;

end;

end;

Result := DISP_E_EXCEPTION;

end;

end;

{ TEventDispatch<T> }

classfunctionTEventDispatch.Create<T>(AOwner: TComponent;

ScriptControl: IScriptControl; ScriptFuncName:String): T;

type

PT = ^T;

var

ed: TEventDispatch;

begin

ed := TEventDispatch.Create(AOwner, TypeInfo(T));

ed.FScriptControl := ScriptControl;

ed.FScriptFuncName := ScriptFuncName;

Result := PT(@ed.FInternalDispatcher)^;

end;

constructorTEventDispatch.Create(AOwner: TComponent; ATTypeInfo: PTypeInfo);

var

LRttiType: TRttiType;

begin

FRttiContext := TRttiContext.Create;

LRttiType := FRttiContext.GetType(ATTypeInfo);

ifnot(LRttiTypeisTRttiMethodType)then

begin

raiseException.Create('T only is Method(Member function)!');

end;

FRttiType := TRttiMethodType(LRttiType);

InheritedCreate(AOwner);

FInternalDispatcher := CreateMethodPointer(InternalInvoke,

GetTypeData(FRttiType.Handle));

end;

destructorTEventDispatch.Destroy;

begin

ReleaseMethodPointer(FInternalDispatcher);

inheritedDestroy;

end;

functionTEventDispatch.ValueToVariant(Value: TValue): Variant;

var

_SetValue: Int64Rec;

begin

Result := EmptyParam;

caseValue.TypeInfo^.Kindof

tkClass:

Result := SA(Value.AsObject);

tkInteger:

Result := Value.AsInteger;

tkString, tkLString, tkChar, tkUString:

Result := Value.AsString;

tkSet:

begin

Value.ExtractRawData(@_SetValue);

caseValue.DataSizeof

1:

Result := _SetValue.Bytes[0];

2:

Result := _SetValue.Words[0];

4:

Result := _SetValue.Cardinals[0];

8:

Result :=Int64(_SetValue);

end;

end;

else

Result := Value.AsVariant;

end;

end;

functionGetParamSize(TypeInfo: PTypeInfo):Integer;

begin

ifTypeInfo =nilthen

Exit(0);

caseTypeInfo^.Kindof

tkInteger, tkEnumeration, tkChar, tkWChar, tkSet:

caseGetTypeData(TypeInfo)^.OrdTypeof

otSByte, otUByte:

Exit(1);

otSWord, otUWord:

Exit(2);

otSLong, otULong:

Exit(4);

else

Exit(0);

end;

tkFloat:

caseGetTypeData(TypeInfo)^.FloatTypeof

ftSingle:

Exit(4);

ftDouble:

Exit(8);

ftExtended:

Exit(SizeOf(Extended));

ftComp:

Exit(8);

ftCurr:

Exit(8);

else

Exit(0);

end;

tkClass, tkClassRef:

Exit(SizeOf(Pointer));

tkInterface:

Exit(-SizeOf(Pointer));

tkMethod:

Exit(SizeOf(TMethod));

tkInt64:

Exit(8);

tkDynArray, tkUString, tkLString, tkWString:

Exit(-SizeOf(Pointer));

tkString:

Exit(GetTypeData(TypeInfo)^.MaxLength +1);

tkPointer:

Exit(SizeOf(Pointer));

tkRecord:

ifIsManaged(TypeInfo)then

Exit(-GetTypeData(TypeInfo)^.RecSize)

else

Exit(GetTypeData(TypeInfo)^.RecSize);

tkArray:

Exit(GetTypeData(TypeInfo)^.ArrayData.Size);

tkVariant:

Exit(-SizeOf(Variant));

else

Exit(0);

end;

end;

procedureTEventDispatch.InternalInvoke(Params: PParameters;

StackSize:Integer);

var

lRttiParameters, tmp: TArray<TRttiParameter>;

lRttiParam: TRttiParameter;

lParamValues: TArray<TValue>;

I, ParamSize:Integer;

PStack: PByte;

test:string;

ParamIsByRef:Boolean;

RegParamIndexs:array[0..2]ofByte;

RegParamIndex:Integer;

v, tmpv: Variant;

ParameterArray: PSafeArray;

begin

tmp := FRttiType.GetParameters;

SetLength(lRttiParameters, Length(tmp) +1);

lRttiParameters[0] :=nil;

forI := Low(tmp)toHigh(tmp)do

lRttiParameters[I +1] := tmp[I];

SetLength(lParamValues, Length(lRttiParameters));

PStack := @Params.Stack[0];

if(FRttiType.CallingConvention = ccReg)then

begin

// 看那些参数用了寄存器传输

FillChar(RegParamIndexs, SizeOf(RegParamIndexs), -1);

RegParamIndexs[0] :=0;

RegParamIndex :=1;

forI :=1toHigh(lRttiParameters)do

begin

lRttiParam := lRttiParameters[I];

ParamSize := GetParamSize(lRttiParam.ParamType.Handle);

ParamIsByRef := (lRttiParam <>nil)and

(([pfVar, pfConst, pfOut] * lRttiParam.Flags) <> []);

if((ParamSize <= SizeOf(Pointer))and

(not(lRttiParam.ParamType.Handle.Kindin[tkFloat])))or(ParamIsByRef)

then

begin

RegParamIndexs[RegParamIndex] := I;

if(RegParamIndex = High(RegParamIndexs))or(I = High(lRttiParameters))

then

Break;

Inc(RegParamIndex);

end;

end;

forI := High(lRttiParameters)downtoLow(lRttiParameters)do

begin

lRttiParam := lRttiParameters[I];

ifI =0then

TValue.Make(Params.EAXRegister, TypeInfo(TObject), lParamValues[I])

else

begin

ParamIsByRef := (lRttiParam <>nil)and

(([pfVar, pfConst, pfOut] * lRttiParam.Flags) <> []);

ParamSize := GetParamSize(lRttiParam.ParamType.Handle);

if(ParamSize < SizeOf(Pointer))or(ParamIsByRef)then

ParamSize := SizeOf(Pointer);

if(Iin[RegParamIndexs[0], RegParamIndexs[1], RegParamIndexs[2]])then

begin

ifParamIsByRefthen

begin

TValue.Make(Pointer(Params.Registers[RegParamIndex]),

lRttiParameters[I].ParamType.Handle, lParamValues[I]);

end

else

begin

TValue.Make(Params.Registers[RegParamIndex],

lRttiParameters[I].ParamType.Handle, lParamValues[I]);

end;

Dec(RegParamIndex);

end

else

begin

ifParamIsByRefthen

TValue.Make(PPointer(PStack)^, lRttiParameters[I].ParamType.Handle,

lParamValues[I])

else

TValue.Make(PStack, lRttiParameters[I].ParamType.Handle,

lParamValues[I]);

Inc(PStack, ParamSize);

end;

end;

end;

end

else

begin

forI := Low(lRttiParameters)toHigh(lRttiParameters)do

begin

ParamIsByRef := (lRttiParameters[I] <>nil)and

(([pfVar, pfConst, pfOut] * lRttiParameters[I].Flags) <> []);

ifI =0then

begin// Self

ParamSize := SizeOf(TObject);

TValue.Make(PStack, TypeInfo(TObject), lParamValues[I]);

end

else

begin

ParamSize := GetParamSize(lRttiParameters[I].ParamType.Handle);

ifParamSize < SizeOf(Pointer)then

ParamSize := SizeOf(Pointer);

// TValue.Make(PStack, lRttiParameters[I].ParamType.Handle, lParamValues[I]);

ifParamIsByRefthen

TValue.Make(PPointer(PStack)^, lRttiParameters[I].ParamType.Handle,

lParamValues[I])

else

TValue.Make(PStack, lRttiParameters[I].ParamType.Handle,

lParamValues[I]);

end;

Inc(PStack, ParamSize);

end;

end;

if(FScriptControl <>nil)and(FScriptFuncName <>'')then

begin

v := VarArrayCreate([0, Length(lParamValues) -1], varVariant);

forI :=1toLength(lParamValues) -1do

begin

test := lRttiParameters[I].Name;

tmpv := ValueToVariant(lParamValues[I]);

v[I -1] := tmpv;

end;

ParameterArray := PSafeArray(TVarData(v).VArray);

FScriptControl.Run(FScriptFuncName, ParameterArray);

end;

end;