本文基于 bccsafe 编写的 TDcefBrowser : 项目开源网址 作者博客,感谢作者的帮助。
我们许多时候需要程序和网页中的 JavaScript 脚本进行交互执行,或者获取网页中 JavaScript 变量的值。本文提供了在使用 TDcefBrowser 做为浏览器时的一种解决办法。也许你早就用了这种方法,可是你没有分享出来,我百度谷歌无果后,和作者交流后,最终实现本单元,效果感觉相对满意,也希望对您有所助益。
首先是这个单元的源码:
unit jsvarhelper; interface uses classes, sysutils, types, dcef3_ceflib, dcefb_Browser, syncobjs, variants; type TJsVars = class protected FEvent: TEvent; FValue: Variant; FBrowser: TDcefBrowser; procedure SetReady;inline; function Wait(ATimeout: Cardinal = INFINITE): TWaitResult; function GetAsBoolean(AName: String): Boolean; function GetAsFloat(AName: String): Double; function GetAsInteger(AName: String): Int64; function GetAsString(AName: String): String; procedure SetAsBoolean(AName: String; const Value: Boolean); procedure SetAsFloat(AName: String; const Value: Double); procedure SetAsInteger(AName: String; const Value: Int64); procedure SetAsString(AName: String; const Value: String); function GetDefined(AName: String): Boolean; public constructor Create(ABrowser: TDcefBrowser); overload; destructor Destroy; override; procedure ExecuteScript(const AScript, AUrl: String; AFromLine: Integer = 0); overload; function ExecuteScript(const AScript: String): Variant; overload; property Defined[AName: String]: Boolean read GetDefined; property AsBoolean[AName: String]: Boolean read GetAsBoolean write SetAsBoolean; property AsInteger[AName: String]: Int64 read GetAsInteger write SetAsInteger; property AsFloat[AName: String]: Double read GetAsFloat write SetAsFloat; property AsString[AName: String]: String read GetAsString write SetAsString; end; implementation type //仅为初始化 TDVarHelper = class protected public end; var VarHelper: TJsVars; resourcestring SCantToVariant = '指定的JavaScript变量无法转换为 Variant'; SJSException = '执行脚本时发生异常:'#13#10'信息:%s'#13#10'位置:第 %d 行 %d 列'#13#10'脚本:'#13#10'%s'; SVarTypeMismatch = '变量 %s 不存在或类型不匹配'; function ToVariant(V: Icefv8Value): Variant; var i: Integer; begin if V.IsString then Result := V.GetStringValue else if V.IsBool then Result := V.GetBoolValue else if V.IsInt then Result := V.GetIntValue else if V.IsDouble then Result := V.GetDoubleValue else if V.IsUndefined then Result := Unassigned else if V.IsNull then Result := Null else if V.IsArray then begin Result := VarArrayCreate([0, V.GetArrayLength], varVariant); for i := 0 to V.GetArrayLength - 1 do begin Result[i] := ToVariant(V.GetValueByIndex(i)); end; end else raise Exception.Create(SCantToVariant); end; { TJsVars } constructor TJsVars.Create(ABrowser: TDcefBrowser); begin inherited Create; FBrowser := ABrowser; FEvent := TEvent.Create(nil, false, false, ''); end; destructor TJsVars.Destroy; begin FreeAndNil(FEvent); inherited; end; function TJsVars.ExecuteScript(const AScript: String): Variant; begin VarHelper := Self; VarClear(Result); FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) var AResult: Icefv8Value; AException: ICefv8Exception; begin try if Assigned(AContext) and AContext.Enter then begin if not AContext.Eval(AScript, AResult, AException) then begin raise Exception.CreateFmt(SJSException, [AException.Message, AException.LineNumber, AException.StartColumn, AException.SourceLine]); end else PVariant(AData)^ := ToVariant(AResult); AContext.Exit; end; finally VarHelper.SetReady; end; end, @Result); Wait; end; procedure TJsVars.ExecuteScript(const AScript, AUrl: String; AFromLine: Integer); var S: String; begin VarHelper := Self; S := S + #13#10 + 'TJsDHelper.SetReady();'; FBrowser.ExecuteJavaScript(S); Wait; end; function TJsVars.GetAsBoolean(AName: String): Boolean; begin Result := false; VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) var AValue: Icefv8Value; AException: ICefv8Exception; begin try if Assigned(AContext) and AContext.Enter then begin AValue := AContext.Global.GetValueByKey(AName); if AValue.IsValid then begin if AValue.IsUndefined then begin if AContext.Eval(AName, AValue, AException) then PBoolean(AData)^ := ToVariant(AValue) else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end else PBoolean(AData)^ := ToVariant(AValue) end else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end; finally VarHelper.SetReady; end; end, @Result); Wait; end; function TJsVars.GetAsFloat(AName: String): Double; begin Result := 0; VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) var AValue: Icefv8Value; AException: ICefv8Exception; begin try if Assigned(AContext) and AContext.Enter then begin AValue := AContext.Global.GetValueByKey(AName); if AValue.IsValid then begin if AValue.IsUndefined then begin if AContext.Eval(AName, AValue, AException) then PDouble(AData)^ := ToVariant(AValue) else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end else PDouble(AData)^ := ToVariant(AValue) end else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end; finally VarHelper.SetReady; end; end, @Result); Wait; end; function TJsVars.GetAsInteger(AName: String): Int64; begin Result := 0; VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) var AValue: Icefv8Value; AException: ICefv8Exception; begin try if Assigned(AContext) and AContext.Enter then begin AValue := AContext.Global.GetValueByKey(AName); if AValue.IsValid then begin if AValue.IsUndefined then begin if AContext.Eval(AName, AValue, AException) then PInteger(AData)^ := ToVariant(AValue) else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end else PInteger(AData)^ := ToVariant(AValue) end else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end; finally VarHelper.SetReady; end; end, @Result); Wait; end; function TJsVars.GetAsString(AName: String): String; begin Result := ''; VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) var AValue: Icefv8Value; AException: ICefv8Exception; begin try if Assigned(AContext) and AContext.Enter then begin AValue := AContext.Global.GetValueByKey(AName); if AValue.IsValid then begin if AValue.IsUndefined then begin if AContext.Eval(AName, AValue, AException) then PString(AData)^ := ToVariant(AValue) else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end else PString(AData)^ := ToVariant(AValue) end else raise Exception.CreateFmt(SVarTypeMismatch, [AName]); end; finally VarHelper.SetReady; end; end, @Result); Wait; end; function TJsVars.GetDefined(AName: String): Boolean; begin Result := false; VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) begin if Assigned(AContext) then begin if AContext.Enter then begin PBoolean(AData)^ := AContext.Global.HasValueByKey(AName); AContext.Exit; end; end; VarHelper.SetReady; end, @Result); Wait; end; procedure TJsVars.SetAsBoolean(AName: String; const Value: Boolean); begin VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) begin try if Assigned(AContext) and AContext.Enter then begin AContext.Global.SetValueByKey(AName, TCefv8ValueRef.NewBool(Value), []); AContext.Exit; end; finally VarHelper.SetReady; end; end, nil); Wait; end; procedure TJsVars.SetAsFloat(AName: String; const Value: Double); begin VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) begin try if Assigned(AContext) and AContext.Enter then begin AContext.Global.SetValueByKey(AName, TCefv8ValueRef.NewDouble(Value), []); AContext.Exit; end; finally VarHelper.SetReady; end; end, nil); Wait; end; procedure TJsVars.SetAsInteger(AName: String; const Value: Int64); begin VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) begin try if Assigned(AContext) and AContext.Enter then begin AContext.Global.SetValueByKey(AName, TCefv8ValueRef.NewInt(Value), []); AContext.Exit; end; finally VarHelper.SetReady; end; end, nil); Wait; end; procedure TJsVars.SetAsString(AName: String; const Value: String); begin VarHelper := Self; FBrowser.ActivePage.RunInRenderProcess( procedure(ASender: TBrowserPage; AContext: ICefv8Context; AData: Pointer) begin try if Assigned(AContext) and AContext.Enter then begin AContext.Global.SetValueByKey(AName, TCefv8ValueRef.NewString(Value), []); AContext.Exit; end; finally VarHelper.SetReady; end; end, nil); Wait; end; procedure TJsVars.SetReady; begin FEvent.SetEvent; end; function TJsVars.Wait(ATimeout: Cardinal): TWaitResult; begin Result := FEvent.WaitFor(INFINITE); end; initialization TCustomDcefBrowser.RegisterClasses([TDVarHelper]); finalization end.
然后是用法的简单说明:
1、当然是放置一个 TDcefBrowser 浏览器实例,假设叫 DcefBrowser1;
2、声明并创建 TJsVars 实例,以上一步的浏览器实例做为参数;
FJsVars:=TJsVars.Create(DcefBrowser1);
3、加载网页,完成后,你就可以通过 FJsVars 做想做的事了:
- 检查一个 JavaScript 变量在当前网页中是否已经定义,如:
if FJsVars.Defined['map'] then ShowMessage('map defined');
- 获取或修改一个 JavaScript 变量的值,如:
FJsVars.AsInteger["scale"]:=100;
- 执行一段 JavaScript 并获取其返回值,如:
var V:Variant; ... V:=FJsVars.Execute('a=100+200;'); ShowMessage(VarToStr(V)); ...
- 做其它想做的事……(好象可以收工了~~~)
好了,示例程序我就不提供了,BccSafe 也许会提供一个。