TChrome中加载JS与delphi交互问题

关于TChrome中加载JS与delphi交互问题,

我这里直接给他代码，是转载的大神的，具体地址忘了。

(*  *                               NeuglsWorkStudio  *                     HTML Interface Javascript Extendtion  *  This unit implmented TNCJsExtented which used for extend the capablity of  *  javascript.  *  *  Author     : Neugls  *  Create time: 4/27/2011  *  *  Thanks for : Henri Gourvest  *  *  *  *  *  *) unit VCL.JSExtented;   interface   uses   SysUtils, Classes,ceflib,Rtti,cefvcl;   const   csErrorParameters            ='Error Parameters';   csHaveNoThisMember           ='Have no member';   csChromiumCouldNotBeNil      ='Chromium could not be nil, please first set the Chromium property';   type   {}   TVCLJsExtended = class(TComponent)     type       TANameType=(ntMethod,ntField,ntProperty);       {Inner class}       TNCJSHandle=class(TCefv8HandlerOwn)         private            FContainer:TVCLJsExtended;         protected           function Execute(const name: ustring; const obj: ICefv8Value;             const arguments: TCefv8ValueArray; var retval: ICefv8Value;             var exception: ustring): Boolean; override;             procedure JsCallMethod(Method:TRttiMethod;out ReturnVal:ICefv8Value; const Param:TCefv8ValueArray);overload;           procedure JsCallMethod(Method:TRttiMethod;out ReturnVal:ICefv8Value);overload;           function MethodParamLength(Mn:string):Integer;         public           constructor Create(Container:TVCLJsExtended);       end;     private     FProcessObject:TObject;     FJsHandle:TNCJSHandle;     FTypeInfo:Pointer;     FCustomChromium:TChromium;     FFrame:ICefFrame;   public     Frame:ICefFrame{  read FFrame write FFrame};     property ProcessObject:TObject read FProcessObject;     property ATypeInfo:Pointer read FTypeInfo;     procedure SetProcessObject(value:TObject;ATypeInfo:Pointer);     Procedure ExecuteJavaScript(const jsCode, scriptUrl: string; startLine: Integer);overload;     Procedure ExecuteJavaScript(const jsCode:string);overload;     constructor create(AOwner:TComponent);override;       property Chromium:TChromium read FCustomChromium write FCustomChromium;   end;     TVCLNcJsExtended = class(TVCLJsExtended)   published     property Chromium;   end;   TNCWebBrowser=class(TChromium)     end;     procedure Register;   implementation uses TypInfo; procedure Register; begin   RegisterComponents('NwControls', [TVCLNcJsExtended]);   RegisterComponents('NwControls', [TChromium]); end;   { TVCLJsExtended }   constructor TVCLJsExtended.create(AOwner:TComponent); begin   inherited create(AOwner);   FProcessObject:=nil;   FJsHandle:=TNCJSHandle.Create(Self); end;   procedure TVCLJsExtended.ExecuteJavaScript(const jsCode, scriptUrl: string;   startLine: Integer); begin   if not Assigned(FCustomChromium) then   begin     raise Exception.Create(csChromiumCouldNotBeNil);     Exit;   end;   FCustomChromium.Browser.MainFrame.ExecuteJavaScript(jsCode,scriptUrl,startLine); end;   procedure TVCLJsExtended.ExecuteJavaScript(const jsCode:string); begin   ExecuteJavaScript(jsCode,'',0); end;   procedure TVCLJsExtended.SetProcessObject(value: TObject;ATypeInfo:Pointer); var    RttiContext:TRttiContext;    RttiType:TRttiType;    RM:TRttiMethod;    RP:TRttiProperty;    RF:TRttiField;      JsStr,name:String;    I:Integer; begin   {     根据object所提供的方法属性生成js字符串，希望注册.   }   FProcessObject:=value;   FTypeInfo:=ATypeInfo;   RttiType:=RttiContext.GetType(FTypeInfo);     name:=RttiType.Name;   JsStr:=Format('var %s;',[name]);   JsStr:=Format('%s if(!%s) %s={};',[JsStr,name,name]);     {Process method}   for RM in RttiType.GetMethods  do   begin     JsStr:=JsStr+Format(#$A#$D' native function %s(',[RM.Name]);     if Length(RM.GetParameters)=0 then       JsStr:=Format('%s);',[JsStr])     else     begin       for I := 0 to Length(RM.GetParameters)-2 do         JsStr:=Format('%s %s,',[JsStr,chr(ord('A')+I)]);       I:=Length(RM.GetParameters)-1;       JsStr:=Format('%s %s);',[JsStr,chr(ord('A')+I)]);     end;   end;     {Process Field}   for RF in RttiType.GetFields  do   begin     JsStr:=Format('%s'#$A#$D' var %s;',[JsStr,RF.Name]);     case RF.FieldType.TypeKind of       tkUnknown: ;       tkInteger: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);       tkChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);       tkEnumeration: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);       tkFloat: JsStr:=Format('%s'#$A#$D' %s=%f;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsExtended]);       tkString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);       tkSet: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);       tkClass:{support later} JsStr:=Format('%s'#$A#$D' %s={};',[JsStr,RF.Name]);       tkMethod: ;       tkWChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);       tkLString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);       tkWString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);       tkVariant: ;       tkArray: ;       tkRecord: ;       tkInterface: ;       tkInt64: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);       tkDynArray: ;       tkUString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);       tkClassRef: ;       tkPointer: ;       tkProcedure: ;     end;   end;     {Process property}   for RP in RttiType.GetProperties  do   begin     JsStr:=Format('%s'#$A#$D' var %s;',[JsStr,RP.Name]);     case RF.FieldType.TypeKind of       tkUnknown: ;       tkInteger: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);       tkChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);       tkEnumeration: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);       tkFloat: JsStr:=Format('%s'#$A#$D' %s=%f;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsExtended]);       tkString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);       tkSet: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);       tkClass:{support later} JsStr:=Format('%s'#$A#$D' %s={};',[JsStr,RP.Name]);       tkMethod: ;       tkWChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);       tkLString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);       tkWString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);       tkVariant: ;       tkArray: ;       tkRecord: ;       tkInterface: ;       tkInt64: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);       tkDynArray: ;       tkUString: if not RP.GetValue(FProcessObject).IsObject then  JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);       tkClassRef: ;       tkPointer: ;       tkProcedure: ;     end;   end;     if not CefRegisterExtension(RttiType.Name,JsStr,FJsHandle) then     Raise Exception.Create('Register JavaScript Extension Error'); end;   { TVCLJsExtended.TNCJSHandle }   constructor TVCLJsExtended.TNCJSHandle.Create(   Container: TVCLJsExtended); begin   inherited Create;   FContainer:=Container; end;   function TVCLJsExtended.TNCJSHandle.Execute(const name: ustring;   const obj: ICefv8Value; const arguments: TCefv8ValueArray;   var retval: ICefv8Value; var exception: ustring): Boolean; var    RttiContext:TRttiContext;    rm:TRttiMember;    M:TRttiMethod;    F:TRttiField;    P:TRttiProperty;    A:TRttiArrayType;    nameType:TANameTYpe;    o:TObject;    n:string;     function ObjectHaveName(const AObject:TObject; const name:String;out isMethod:TANameTYpe; out mb:TRttiMember):Boolean;   var      RttiType:TRttiType;      RM:TRttiMethod;      RP:TRttiProperty;      RF:TRttiField;   begin      Result:=false;      RttiType:=RttiContext.GetType(FContainer.FTypeInfo);      for RM in RttiType.GetMethods do      begin        if CompareText(RM.Name,name)=0 then        begin          isMethod:=ntMethod;          mb:=RM;          Exit(True);        end;      end;        for RP in RttiType.GetProperties do      begin        if CompareText(RP.Name,name)=0 then        begin          isMethod:=ntProperty;          mb:=RP;          Exit(True);        end;      end;        for RF in RttiType.GetFields do      begin        if CompareText(RF.Name,name)=0 then        begin          isMethod:=ntField;          mb:=RF;          Exit(True);        end;      end;   end; begin   Result:=true;   O:=FContainer.ProcessObject;   n:=name;   if not ObjectHaveName(O,name,nameType,rm) then   begin      exception:=csHaveNoThisMember;      Exit(False);   end;     case nameType of     ntMethod:     begin        M:=rm as TRttiMethod;          //Assert(M.MethodKind<>mkFunction);        if Length(M.GetParameters)>0 then        begin          if (Length(arguments)>0) and (Length(arguments)=Length(M.GetParameters)) then          begin            JsCallMethod(M,retval,arguments);            end          else          begin            exception:=csErrorParameters;            Exit(False);          end;        end        else        begin          JsCallMethod(M,retval);        end;       end;     ntField:     begin        F:=rm as TRttiField;        case F.FieldType.TypeKind of          tkUnknown: ;          tkInteger: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);          tkChar: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);          tkEnumeration: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);          tkFloat: retval:=TCefv8ValueRef.CreateDouble(F.GetValue(FContainer.ProcessObject).AsExtended);          tkString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);          tkSet: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);          tkClass: ;//retval:=TCefv8ValueRef.CreateObject(F.GetValue(FContainer.ProcessObject).AsObject);          tkMethod: ;          tkWChar: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);          tkLString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);          tkWString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);          tkVariant: ;          tkArray:          begin                    {                     retval:=TCefv8ValueRef.CreateArray;                     A:=F.FieldType as TRttiArrayType;                     //support only one demision array                     if A.DimensionCount=1 then                      for I := 0 to A.TotalElementCount do                      begin                        case A.ElementType.TypeKind of                          tkUnknown: retval.SetValueByIndex(I,TCefv8ValueRef.create());                          tkInteger: ;                          tkChar: ;                          tkEnumeration: ;                          tkFloat: ;                          tkString: ;                          tkSet: ;                          tkClass: ;                          tkMethod: ;                          tkWChar: ;                          tkLString: ;                          tkWString: ;                          tkVariant: ;                          tkArray: ;                          tkRecord: ;                          tkInterface: ;                          tkInt64: ;                          tkDynArray: ;                          tkUString: ;                          tkClassRef: ;                          tkPointer: ;                          tkProcedure: ;                        end;                        retval.SetValueByIndex(I,TCefv8ValueRef.create)                      end;                           retval.SetValueByIndex()                   end;;            tkRecord: ;            tkInterface: ;            tkInt64: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);            tkDynArray: ;            tkUString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);            tkClassRef: ;            tkPointer: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);            tkProcedure: ;  }          end;        end;     end;     ntProperty:      begin        P:=rm as TRttiProperty;        case P.PropertyType.TypeKind of          tkUnknown: ;          tkInteger: retval:=TCefv8ValueRef.CreateInt(p.GetValue(FContainer.ProcessObject).AsInteger);          tkChar: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);          tkEnumeration: retval:=TCefv8ValueRef.CreateInt(p.GetValue(FContainer.ProcessObject).AsInteger);          tkFloat: retval:=TCefv8ValueRef.CreateDouble(p.GetValue(FContainer.ProcessObject).AsExtended);          tkString: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);          tkSet: retval:=TCefv8ValueRef.CreateInt(p.GetValue(FContainer.ProcessObject).AsInteger);          tkClass: ;//retval:=TCefv8ValueRef.CreateObject(p.GetValue(FContainer.ProcessObject).AsObject);          tkMethod: ;          tkWChar: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);          tkLString: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);          tkWString: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);          tkVariant: ;          tkArray:;        end;      end;   end;   end;     procedure TVCLJsExtended.TNCJSHandle.JsCallMethod(Method: TRttiMethod;   out ReturnVal: ICefv8Value; const Param: TCefv8ValueArray); var    VA:array of TValue;    I:Integer;    rva:TValue;    AInstance:TObject; begin   if Param<>nil then   begin     SetLength(VA,Length(Param));     for I := 0 to Length(Method.GetParameters)-1 do     begin       if Param[I].IsBool then          VA[I]:=TValue.From<Boolean>(Param[I].GetBoolValue);         if Param[I].IsInt then       begin          VA[I]:=TValue.From<Integer>(Param[I].GetIntValue);          Continue;       end;         if Param[I].IsDouble then       begin          VA[I]:=TValue.From<Double>(Param[I].GetDoubleValue);          Continue;       end;           if Param[I].IsString then          VA[I]:=TValue.From<String>(Param[I].GetStringValue);         if Param[I].IsObject then          {VA[I].AsObject:=Param[I].get};       //if Param[I].is then           end;   end   else       ;//VA:=nil;   AInstance:=FContainer.ProcessObject;   Rva:=Method.Invoke(AInstance,VA);   case rva.Kind of     tkUnknown: ;     tkInteger: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsInteger);     tkChar: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);     tkEnumeration: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsOrdinal);     tkFloat: ReturnVal:=TCefv8ValueRef.CreateDouble(rva.AsExtended);     tkString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);     tkSet: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsInteger);     tkClass: ;//ReturnVal:=TCefv8ValueRef.CreateObject(rva.AsObject);     tkMethod: ;     tkWChar: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);     tkLString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);     tkWString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);     tkVariant: ;     tkArray:;     tkRecord: ;     tkInterface: ;     tkInt64: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsInteger);     tkDynArray: ;     tkUString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);     tkClassRef: ;     tkPointer: ;     tkProcedure: ;   end; end;   procedure TVCLJsExtended.TNCJSHandle.JsCallMethod(Method: TRttiMethod;   out ReturnVal: ICefv8Value); begin   JsCallMethod(Method,ReturnVal,nil); end;   function TVCLJsExtended.TNCJSHandle.MethodParamLength(Mn: string): Integer; var    Rtx:TRttiContext;    M:TRttiMethod;    RT:TRttiType; begin    RT:=Rtx.GetType(FContainer.FTypeInfo);    M:=Rt.GetMethod(Mn);    Result:=Length(M.GetParameters); end;       end.

 这是一个控件，他的功能是把delphi函数预注册到程序环境中，这样，在本程序内的所有chrome控件，都可以通过js调用到delphi函数，不过请注意，最好不要用到boolean类型的变量，这样会导致js调用不到delphi。

具体的用法可以在网上搜索下，我就里就不详细写了，毕竟是转载的。