奇技淫巧之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 ;