[DCEF3] Delphi 与网页中 JavaScript 交互控制

作者：/

dcef3, JavaScript, 交互, 变量, 访问

本文基于 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 也许会提供一个。

滚动至顶部