关于TChrome中加载JS与delphi交互问题,回复liqiao的提问

By | 03月08日
Advertisement

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

(*   *                               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。

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

Similar Posts:

  • 在HTML文件中加载js

    js加载只分为两种: 1.全局js,放在<head>标签里面,整个页面很多都用到的,它是优先加载的. 2.局部js,放在</html>结束标签以内的任何位置,它是第二加载的.

  • 关于JSP中加载js,check函数不能正确抛异常

    事情是这样的.在最近的一次保守任务中,需要修改一个jsp页面的检查输入的函数,该函数是用javascript写的脚本,内嵌在jsp代码里的. 在原本的jsp里,已经有了一些check的判断,在js脚本里继续追加check代码后,问题出现了:check抛出的异常不能正常显示. 经过一番折腾,将这些check的javascript脚本单独拿出来,放到一个js文件里,然后script标签,导入这个js文件,问题解决. 初步判断:jsp中内嵌的javascript代码太长,导致了这个问题. 解决办法:不

  • Delphi中加载并运行内存中的EXE

    { ******************************************************* } { * 从内存中加载并运行exe * } { ******************************************************* } { * 参数: } { * Buffer: 内存中的exe地址 } { * Len: 内存中exe占用长度 } { * CmdParam: 命令行参数(不包含exe文件名的剩余命令行参数)} { * ProcessId

  • 动态加载JS代码

    到处查资料研究js动态脚本的加载,找到以下7种方法,总有一种适合你! 首先我们需要一个被加载的js文件,我在一个固定文件夹下创建了一个package.js,打开后在里面写一个方法functionOne,很简单,代码如下: function functionOne(){ alert("成功加载"); } 后面的html文件都创建在同一个目录下. 方法一:直接document.write 在同一个文件夹下面创建一个function1.html,代码如下: <html> <

  • 动态加载JS脚本的4种方法

    实现OPOA(One Page One Application)时,必须使用动态加载js. 也就是在用户选择某个菜单项后,再动态加载对应的全部js到客户端. 动态加载js的情况很多啊,比如解决ajax跨域问题,就是动态载入一个js脚本. 本文给出的四个方法,前三个是异步加载js.就是js加载和当前js脚本执行是两个线程,先加载完还是先执行当前脚本是不确定的.在加载这些脚本的同时,主页面的脚本继续运行. 第四个办法尝试用XMLHTTP取得要脚本的内容,再创建 Script 对象.经过测试,仍然不能

  • 动态加载JS文件(支持各种浏览器)

    我是一个喜欢偷懒的程序员,什么事情都想能封装就封装,能系统自动做就自动做,所以咯,为了这个目的,最近开始写一套自己的框架. 首先,我开始了JS框架的编写:为了让页面打开的时候,系统就自动的去填充一些数据,比如 select(获取这个select的数据,后台代码已经写好,在web容器一开始的时候就去获取数据,然后放在缓存当中,以后只要从这个缓存读取就可以了) 等,所以我开始了写这个功能 1.我写了一个common.js文件,这里面的功能都是系统自动会去执行的方法,这个文件里面会自动的去页面查找我指

  • 异步加载JS

    平时最常使用的就是这种同步加载形式: <script src="http://yourdomain.com/script.js"></script> 同步模式,又称阻塞模式,会阻止浏览器的后续处理,停止了后续的解析,因此停止了后续的文件加载(如图像).渲染.代码执行. js 之所以要同步执行,是因为 js 中可能有输出 document 内容.修改dom.重定向等行为,所以默认同步执行才是安全的. 以前的一般建议是把<script>放在页面末尾<

  • prototype:加载jsp页面加载时执行js方法或者页面加载js文件时执行init方法

    页面加载时执行的js方法: jsp中: Event.observe(window, 'load', function() { alert("init method"); }); 或者: Event.observe(window, 'load',init()); function init() { alert("init method"); } ______________________________________________________________

  • JS开发前台代码架构设计,JQ动态加载JS文件,并立即执行其方法。

    为实现.一个页面处理所有系统维护表单.又能很好的管理系统代码.做了这样一个架构: 每个表单做一个xml与js文件.xml内自定义(或使用HTML代码)来描述表单的内容及样式.js文件内放入该表单的处理文件.系统使用到改表单时,由主界面动态将表单所属的js与xml文件加载到主页面.并生成表单.动态加载JS文件,并立即执行其方法的代码如下: 动态加载Js.Css文件代码: //动态加载文件代码 $.extend({ includePath: '', include: function (file)

  • JavaScript几种动态加载JS脚本的方法

    几种动态加载JS脚本的方法 已有 277 次阅读 2010-03-12 08:36 标签: 加载 脚本 动态 能实现动态加载javascript脚本的方法有好些,主要介绍几种: 1.直接document.write <script language="javascript"> document.write("<script src='test.js'></script>"); </script> 2.动态改变已有scr

Tags: