奇技淫巧之Delphi和JavaScript互通

http://www.raysoftware.cn/?p=305

Delphi2010以后增加了新的RTTI信息,也就是通过RTTI可以在运行时获取/调用对象的公开成员或者函数.
ScriptControl可以添加外部的对象,这个对象是个IDispatch接口,脚本调用的时候实际上是调用IDispatch的Invoke方法.
那么我们只要实现了IDispatch的Invoke方法,在里面通过RTTI再转而调用Delphi对象的Public方法即可.通过这个可以代理任何Delphi的对象.

仅仅调用Delphi对象似乎还不够完美,对象事件如果能关联到脚本的函数就更好了.那好,封装一个事件代理的类就可以.
例子如下:

procedure TForm1.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;

看上去很爽吧.
不过这个仅供我自己玩的,代码实现的比较毛糙,也没有经过严格的测试,甚至自己也没从头到尾再检查一次.如果有需要实用的朋友最好谨慎,肯定有细节问题要解决.
另外这个ScriptControl仅仅有32位的,在64位Windows上的system32里面并没有这个DLL,仅仅在SysWow64中才有.也就是说如果你要开发64位Windows程序就不能用了.当然如果是在64位Windows中运行的32位程序则没问题.

下面是代码,写的比较丑.

{   让Delphi使用windows自带的scriptcontrol,在javascript中可以调用delphi的对象,   并且可以使用事件.   wr960204武稀松 2013 } unit ScriptObjectUtilsWithRTTI;    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}']     function Get_Language: WideString; safecall;     procedure Set_Language(const pbstrLanguage: WideString); safecall;     function Get_State: ScriptControlStates; safecall;     procedure Set_State(pssState: ScriptControlStates); safecall;     procedure Set_SitehWnd(phwnd: Integer); safecall;     function Get_SitehWnd: Integer; safecall;     function Get_Timeout: Integer; safecall;     procedure Set_Timeout(plMilleseconds: Integer); safecall;     function Get_AllowUI: WordBool; safecall;     procedure Set_AllowUI(pfAllowUI: WordBool); safecall;     function Get_UseSafeSubset: WordBool; safecall;     procedure Set_UseSafeSubset(pfUseSafeSubset: WordBool); safecall;     function Get_Modules: IScriptModuleCollection; safecall;     function Get_Error: IScriptError; safecall;     function Get_CodeObject: IDispatch; safecall;     function Get_Procedures: IScriptProcedureCollection; safecall;     procedure _AboutBox; safecall;     procedure AddObject(const Name: WideString; const Object_: IDispatch;       AddMembers: WordBool); safecall;     procedure Reset; safecall;     procedure AddCode(const Code: WideString); safecall;     function Eval(const Expression: WideString): OleVariant; safecall;     procedure ExecuteStatement(const Statement: WideString); safecall;     function Run(const ProcedureName: WideString; var Parameters: PSafeArray)       : OleVariant; safecall;     property Language: WideString read Get_Language write Set_Language;     property State: ScriptControlStates read Get_State write Set_State;     property SitehWnd: Integer read Get_SitehWnd write Set_SitehWnd;     property Timeout: Integer read Get_Timeout write Set_Timeout;     property AllowUI: WordBool read Get_AllowUI write Set_AllowUI;     property UseSafeSubset: WordBool read Get_UseSafeSubset       write Set_UseSafeSubset;     property Modules: IScriptModuleCollection read Get_Modules;     property Error: IScriptError read Get_Error;     property CodeObject: IDispatch read Get_CodeObject;     property Procedures: 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;     procedure InternalInvoke(Params: PParameters; StackSize: Integer);     function ValueToVariant(Value: TValue): Variant;     constructor Create(AOwner: TComponent; ATTypeInfo: PTypeInfo);       reintroduce; overload;   public     class function Create<T>(AOwner: TComponent; ScriptControl: IScriptControl;       ScriptFuncName: String): T; reintroduce; overload;        destructor Destroy; override;      end;      { 很普通,创建一个MSWindows自带的ScriptControl实例,默认脚本是Javascript } function CreateScriptControl(ScriptName: String = 'javascript'): IScriptControl; { 创建对象的IDispatch的代理, Owned表示这个IDispatch拥有代理对象的生杀大权,当代理的IDispatch   释放的时候这个Obj也会被释放掉 } function SA(Obj: TObject; Owned: Boolean): IDispatch; overload; { 创建对象的IDispatch的代理 } function SA(Obj: TObject): IDispatch; overload;    implementation    uses {$IFNDEF COMOBJ_FROMDLL}   System.Win.ComObj, {$ENDIF}   System.SysUtils;    function CreateScriptControl(ScriptName: String): IScriptControl; const   CLASS_ScriptControl: TGUID = '{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}'; {$IFDEF COMOBJ_FROMDLL}   MSSCRIPTMODULE = 'msscript.ocx'; var   DllGetClassObject: function(const clsid, IID: TGUID; var Obj)     : HRESULT; stdcall;   ClassFactory: IClassFactory;   hLibInst: HMODULE;   hr: HRESULT; begin   Result := nil;   hLibInst := GetModuleHandle(MSSCRIPTMODULE);   if hLibInst = 0 then     hLibInst := LoadLibrary(MSSCRIPTMODULE);   if hLibInst = 0 then     Exit;   DllGetClassObject := GetProcAddress(hLibInst, 'DllGetClassObject');   if Assigned(DllGetClassObject) then   begin     hr := DllGetClassObject(CLASS_ScriptControl, IClassFactory, ClassFactory);     if hr = S_OK then     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) as IScriptControl;   if Result <> nil then     Result.Language := ScriptName; end; {$ENDIF}    type   TDispatchKind = (dkMethod, dkProperty, dkSubComponent);      TDispatchInfo = record     Instance: TObject;     case Kind: TDispatchKind of       dkMethod:         (MethodInfo: TRttiMethod);       dkProperty:         (PropInfo: TRttiProperty);       dkSubComponent:         (ComponentInfo: NativeInt);   end;      TDispatchInfos = array of TDispatchInfo;      {     IDispatch代理类.通过RTTI可以把Delphi对象的成员/属性/函数映射给IDispatch.     而且忽略调用协议.   }   TScriptObjectAdapter = class(TInterfacedObject, IDispatch)   private     //     FRttiContext: TRttiContext;     FRttiType: TRttiType;     FDispatchInfoCount: Integer;     FDispatchInfos: TDispatchInfos;     FComponentNames: TStrings;     FInstance: TObject;     FOwned: Boolean;     function AllocDispID(AKind: TDispatchKind; Value: Pointer;       AInstance: TObject): TDispID;   protected     property Instance: TObject read FInstance;   public     { IDispatch }     function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount: Integer;       LocaleID: Integer; DispIDs: Pointer): HRESULT; virtual; stdcall;     function GetTypeInfo(Index: Integer; LocaleID: Integer; out TypeInfo)       : HRESULT; stdcall;     function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;       Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;       ArgErr: Pointer): HRESULT; virtual; stdcall;   public     constructor Create(Instance: TObject; Owned: Boolean = False);     destructor Destroy; override;   end;    function SA(Obj: TObject; Owned: Boolean): IDispatch; begin   Result := TScriptObjectAdapter.Create(Obj, Owned); end;    function SA(Obj: TObject): IDispatch; begin   Result := TScriptObjectAdapter.Create(Obj, False); end;    const   ofDispIDOffset = 100;      { TScriptObjectAdapter }    function TScriptObjectAdapter.AllocDispID(AKind: TDispatchKind; Value: Pointer;   AInstance: TObject): TDispID; var   I: Integer;   dispatchInfo: TDispatchInfo; begin   for I := FDispatchInfoCount - 1 downto 0 do     with FDispatchInfos[I] do       if (Kind = AKind) and (MethodInfo = Value) then       begin         // Already have a dispid for this methodinfo         Result := ofDispIDOffset + I;         Exit;       end;   if FDispatchInfoCount = Length(FDispatchInfos) then     SetLength(FDispatchInfos, Length(FDispatchInfos) + 10);   Result := ofDispIDOffset + FDispatchInfoCount;   with dispatchInfo do   begin     Instance := AInstance;     Kind := AKind;     MethodInfo := Value;   end;   FDispatchInfos[FDispatchInfoCount] := dispatchInfo;   Inc(FDispatchInfoCount); end;    constructor TScriptObjectAdapter.Create(Instance: TObject; Owned: Boolean); begin   inherited Create;   FComponentNames := TStringList.Create;   FInstance := Instance;   FOwned := Owned;   FRttiContext := TRttiContext.Create;   FRttiType := FRttiContext.GetType(FInstance.ClassType); end;    destructor TScriptObjectAdapter.Destroy; begin   if FOwned then     FInstance.Free;   FRttiContext.Free;   FComponentNames.Free;   inherited Destroy; end;    function TScriptObjectAdapter.GetIDsOfNames(const IID: TGUID; Names: Pointer;   NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; type   PNames = ^TNames;   TNames = array [0 .. 100] of POleStr;   PDispIDs = ^TDispIDs;   TDispIDs = array [0 .. 100] of Cardinal; 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, ['']);   if MethodInfo <> nil then   begin     lDispId := AllocDispID(dkMethod, MethodInfo, FInstance);   end   else   begin     PropertInfo := FRttiType.GetProperty(Name);     if PropertInfo <> nil then     begin       lDispId := AllocDispID(dkProperty, PropertInfo, FInstance);     end     else if FInstance is TComponent then     begin       ComponentInfo := TComponent(FInstance).FindComponent(Name);       if ComponentInfo <> nil then       begin            lDispId := AllocDispID(dkSubComponent, Pointer(FComponentNames.Add(Name)           ), FInstance);       end;     end;   end;   if lDispId >= ofDispIDOffset then   begin     Result := S_OK;     PDispIDs(DispIDs)^[0] := lDispId;   end; end;    function TScriptObjectAdapter.GetTypeInfo(Index, LocaleID: Integer;   out TypeInfo): HRESULT; begin   Result := E_NOTIMPL; end;    function TScriptObjectAdapter.GetTypeInfoCount(out Count: Integer): HRESULT; begin   Result := E_NOTIMPL; end;    function TScriptObjectAdapter.Invoke(DispID: Integer; const IID: TGUID;   LocaleID: Integer; Flags: Word; var Params;   VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; type   PVariantArray = ^TVariantArray;   TVariantArray = array [0 .. 65535] of Variant;   PIntegerArray = ^TIntegerArray;   TIntegerArray = array [0 .. 65535] of Integer; 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     if VarResult = nil then       VarResult := @TempRet;     if (DispID - ofDispIDOffset >= 0) and       (DispID - ofDispIDOffset < FDispatchInfoCount) then     begin       dispatchInfo := FDispatchInfos[DispID - ofDispIDOffset];       case dispatchInfo.Kind of         dkProperty:           begin             if Flags and (DISPATCH_PROPERTYPUTREF or DISPATCH_PROPERTYPUT) <> 0             then               if (Parms.cNamedArgs <> 1) or                 (PIntegerArray(Parms.rgdispidNamedArgs)^[0] <>                 DISPID_PROPERTYPUT) then                 Result := DISP_E_MEMBERNOTFOUND               else               begin                 propertyValue := TValue.Empty;                 case dispatchInfo.PropInfo.PropertyType.Handle^.Kind of                   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             else if Parms.cArgs <> 0 then               Result := DISP_E_BADPARAMCOUNT             else if dispatchInfo.PropInfo.PropertyType.Handle^.Kind = tkClass             then               POleVariant(VarResult)^ :=                 SA(dispatchInfo.PropInfo.GetValue(dispatchInfo.Instance)                 .AsObject()) as IDispatch             else               POleVariant(VarResult)^ := dispatchInfo.PropInfo.GetValue                 (dispatchInfo.Instance).AsVariant;           end;         dkMethod:           begin             paramInfos := dispatchInfo.MethodInfo.GetParameters;             SetLength(lParams, Length(paramInfos));             for I := Low(paramInfos) to High(paramInfos) do               if I < Parms.cArgs then               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()) as IDispatch;             end             else             begin               POleVariant(VarResult)^ := dispatchInfo.MethodInfo.Invoke                 (dispatchInfo.Instance, lParams).AsVariant();             end;           end;         dkSubComponent:           begin             component := TComponent(dispatchInfo.Instance)               .FindComponent(FComponentNames[dispatchInfo.ComponentInfo]);             if component = nil then               Result := DISP_E_MEMBERNOTFOUND;                POleVariant(VarResult)^ := SA(component) as IDispatch;           end;       end;     end     else       Result := DISP_E_MEMBERNOTFOUND;   except     if ExcepInfo <> nil then     begin       FillChar(ExcepInfo^, SizeOf(TExcepInfo), 0);       with TExcepInfo(ExcepInfo^) do       begin         bstrSource := StringToOleStr(ClassName);         if ExceptObject is Exception then           bstrDescription := StringToOleStr(Exception(ExceptObject).Message);         scode := E_FAIL;       end;     end;     Result := DISP_E_EXCEPTION;   end; end;    { TEventDispatch<T> }    class function TEventDispatch.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;    constructor TEventDispatch.Create(AOwner: TComponent; ATTypeInfo: PTypeInfo); var   LRttiType: TRttiType; begin   FRttiContext := TRttiContext.Create;   LRttiType := FRttiContext.GetType(ATTypeInfo);   if not(LRttiType is TRttiMethodType) then   begin     raise Exception.Create('T only is Method(Member function)!');   end;   FRttiType := TRttiMethodType(LRttiType);   Inherited Create(AOwner);   FInternalDispatcher := CreateMethodPointer(InternalInvoke,     GetTypeData(FRttiType.Handle)); end;    destructor TEventDispatch.Destroy; begin   ReleaseMethodPointer(FInternalDispatcher);   inherited Destroy; end;    function TEventDispatch.ValueToVariant(Value: TValue): Variant; var   _SetValue: Int64Rec; begin   Result := EmptyParam;   case Value.TypeInfo^.Kind of     tkClass:       Result := SA(Value.AsObject);     tkInteger:       Result := Value.AsInteger;     tkString, tkLString, tkChar, tkUString:       Result := Value.AsString;     tkSet:       begin         Value.ExtractRawData(@_SetValue);         case Value.DataSize of           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;    function GetParamSize(TypeInfo: PTypeInfo): Integer; begin   if TypeInfo = nil then     Exit(0);      case TypeInfo^.Kind of     tkInteger, tkEnumeration, tkChar, tkWChar, tkSet:       case GetTypeData(TypeInfo)^.OrdType of         otSByte, otUByte:           Exit(1);         otSWord, otUWord:           Exit(2);         otSLong, otULong:           Exit(4);       else         Exit(0);       end;     tkFloat:       case GetTypeData(TypeInfo)^.FloatType of         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:       if IsManaged(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;    procedure TEventDispatch.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] of Byte;   RegParamIndex: Integer;   v, tmpv: Variant;   ParameterArray: PSafeArray; begin   tmp := FRttiType.GetParameters;   SetLength(lRttiParameters, Length(tmp) + 1);   lRttiParameters[0] := nil;   for I := Low(tmp) to High(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;     for I := 1 to High(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.Kind in [tkFloat]))) or (ParamIsByRef)       then       begin         RegParamIndexs[RegParamIndex] := I;         if (RegParamIndex = High(RegParamIndexs)) or (I = High(lRttiParameters))         then           Break;         Inc(RegParamIndex);       end;        end;     for I := High(lRttiParameters) downto Low(lRttiParameters) do     begin       lRttiParam := lRttiParameters[I];          if I = 0 then         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 (I in [RegParamIndexs[0], RegParamIndexs[1], RegParamIndexs[2]]) then         begin           if ParamIsByRef then           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           if ParamIsByRef then             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     for I := Low(lRttiParameters) to High(lRttiParameters) do     begin       ParamIsByRef := (lRttiParameters[I] <> nil) and         (([pfVar, pfConst, pfOut] * lRttiParameters[I].Flags) <> []);       if I = 0 then       begin // Self         ParamSize := SizeOf(TObject);         TValue.Make(PStack, TypeInfo(TObject), lParamValues[I]);       end       else       begin         ParamSize := GetParamSize(lRttiParameters[I].ParamType.Handle);         if ParamSize < SizeOf(Pointer) then           ParamSize := SizeOf(Pointer);            // TValue.Make(PStack, lRttiParameters[I].ParamType.Handle,  lParamValues[I]);         if ParamIsByRef then           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);     for I := 1 to Length(lParamValues) - 1 do     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;