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

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

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

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