Delphi Chromium - 迭代 DOM

Question

我正在尝试使用 TChromium 迭代 DOM，因为我使用 Delphi 2007，所以我无法使用匿名方法，所以我创建了一个继承 TCEFDomVisitorOwn 的类。我的代码如下，但由于某种原因，“访问”过程从未被调用，所以什么也没有发生。

unit udomprinc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ceflib, cefvcl;

type
  TForm1 = class(TForm)
    Chromium1: TChromium;
    procedure FormCreate(Sender: TObject);
    procedure Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame;
      httpStatusCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TElementVisitor = class(TCefDomVisitorOwn)
  private
    FTagName, FHtml: string;
  protected
    procedure visit(const document: ICefDomDocument); override;
  public
    constructor Create(const par1, par2: string); reintroduce;
  end;

var
  Form1: TForm1;

implementation

constructor TElementVisitor.Create(const par1, par2: string);
begin
inherited create;
FTagName := par1;
FHtml := par2;
end;

procedure TElementVisitor.visit(const document: ICefDomDocument);
  procedure ProcessNode(ANode: ICefDomNode);
  var
    Node: ICefDomNode;
    tagname, name, html, value : string;
  begin
    if Assigned(ANode) then
    begin
      Node := ANode.FirstChild;
      while Assigned(Node) do
      begin
        name := Node.GetElementAttribute('name');
        tagname := Node.GetElementAttribute('tagname');
        html := Node.GetElementAttribute('outerhtml');
        value := Node.GetElementAttribute('value');
        ProcessNode(Node);
        Node := Node.NextSibling;
      end;
    end;
  end;
begin
 // this never happens
 ProcessNode(document.Body);
end;

{$R *.dfm}

procedure TForm1.Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame;
  httpStatusCode: Integer);
var visitor : TElementVisitor;
begin
  visitor := TElementVisitor.Create('input','test');
  chromium1.Browser.MainFrame.VisitDom(visitor);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
chromium1.load('www.google.com');
end;

end.

Answer 1

这都是关于来回发送消息的。您的代码缺少 RenderProcessHandler，这允许渲染器接收消息。

在您的 DPR 中，您应该有这样的代码

  if not CefLoadLibDefault then
    Exit;

在你的 pas 文件中

type
  TNotifyVisitor = procedure(aNode: ICefDomNode; var aLevel: integer);// of object;

  TAttributeType = (atNodeName, atName, atId, atClass, atLevel);

  TElementNameVisitor = class(TCefDomVisitorOwn)
  private
    FName: string;
    FAttributeName: string;
    FOnFound: TNotifyVisitor;
    FOnVisited: TNotifyVisitor;
    function getAttributeName: string;
  protected
    procedure visit(const document: ICefDomDocument); override;
  public
    constructor Create(const AName: string); reintroduce;
    property OnFound: TNotifyVisitor read FOnFound write FOnFound;
    property OnVisited: TNotifyVisitor read FOnVisited write FOnVisited;
    property AttributeName: string read getAttributeName write FAttributeName;
  end;

  TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
    protected
      function OnProcessMessageReceived(const browser: ICefBrowser;
        sourceProcess: TCefProcessId; const message: ICefProcessMessage): Boolean; override;
  end;

implementation
var
  _Browser: ICefBrowser;

{ TElementNameVisitor }

constructor TElementNameVisitor.Create(const AName: string);
begin
  inherited Create;
   FName := AName;
end;

function TElementNameVisitor.getAttributeName: string;
begin
  if FAttributeName = '' then
    Result := 'name'
  else
    Result := FAttributeName;
end;

procedure TElementNameVisitor.visit(const document: ICefDomDocument);
var
  a_Level: integer;
  a_message: iCefProcessMessage;
  procedure ProcessNode(aNode: ICefDomNode; var aLevel: integer);
  var
    a_Node: ICefDomNode;
    a_Name: string;
  begin
    if Assigned(aNode) then
    begin
      inc(aLevel);
      a_Node := aNode.FirstChild;
      while Assigned(a_Node) do
      begin
        if Assigned(FOnVisited) then
          FOnVisited(a_Node, aLevel);
        if Assigned(FOnFound) then
        begin
          a_Name := a_Node.GetElementAttribute(AttributeName);
          if SameText(a_Name, FName) then
          begin
            // do what you need with the Node here
            if Assigned(FOnFound) then
              FOnFound(a_Node, aLevel);
          end;
        end;
        ProcessNode(a_Node, aLevel);
        a_Node := a_Node.NextSibling;
      end;
    end;
  end;
begin
  a_Level := 0;
  ProcessNode(document.Body, a_Level);
  a_message := TCefProcessMessageRef.New(cdomdataFin);
  _Browser.SendProcessMessage(PID_BROWSER, a_message);
end;

您需要创建一个 RenderProcessHandler:

initialization
  CefRenderProcessHandler := TCustomRenderProcessHandler.Create;

要使用它...您可以像这样向渲染器发送消息

function TformBrowser.HasBrowser: boolean;
begin
  Result := Assigned(Chromium1.browser);
end;

procedure TformBrowser.Button1Click(Sender: TObject);
var
  a_message: ICefProcessMessage;
  a_list: ICefListValue;
  a_How: string;
begin
  if HasBrowser and FLoaded then
  begin
    FLoaded := False;
    Case rgFindDomNodeBy.ItemIndex of
      0: a_How := 'ByName';
      1: a_How := 'ById';
      2: a_How := 'ByClass';
      3: a_How := 'ByAll';
    end;
    lbFrames.Items.Clear;
    a_message := TCefProcessMessageRef.New(a_How);
    a_list := a_message.ArgumentList;
    a_list.SetString(0, edtAttribute.Text);

    Chromium1.browser.SendProcessMessage(PID_RENDERER,a_message);
  end;
end;

RenderProcessHandler 将收到消息:

{ TCustomRenderProcessHandler }


procedure _ElementCB(aNode: ICefDomNode; var aLevel: integer);
var
  a_message: ICefProcessMessage;
begin
  a_message := TCefProcessMessageRef.New('domdata');
  a_message.ArgumentList.SetString(Ord(atNodeName), aNode.Name);
  a_message.ArgumentList.SetString(Ord(atName), aNode.GetElementAttribute('name'));
  a_message.ArgumentList.SetString(Ord(atId), aNode.GetElementAttribute('id'));
  a_message.ArgumentList.SetString(Ord(atClass), aNode.GetElementAttribute('class'));
  a_message.ArgumentList.SetInt(Ord(atLevel), aLevel);

  _Browser.SendProcessMessage(PID_BROWSER, a_message);
end;

function TCustomRenderProcessHandler.OnProcessMessageReceived(
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage): Boolean;
var
  a_list: ICefListValue;
begin
  _Browser := browser;
  Result := False;
  if SameText(message.Name, 'ByAll') then
  begin
    _ProcessElements(browser.MainFrame, _ElementCB);
    Result := True;
  end else
  if SameText(message.Name, 'ByName') then
  begin
    a_list := message.ArgumentList;
    _ProcessElementsByAttribute(browser.MainFrame, a_list.GetString(0),'name', _ElementCB);
    Result := True;
  end else
  if SameText(message.Name, 'ById') then
  begin
    a_list := message.ArgumentList;
    _ProcessElementsByAttribute(browser.MainFrame, a_list.GetString(0), 'id', _ElementCB);
    Result := True;
  end else
  if SameText(message.Name, 'ByClass') then
  begin
    a_list := message.ArgumentList;
    _ProcessElementsByAttribute(browser.MainFrame, a_list.GetString(0), 'class', _ElementCB);
    Result := True;
  end;
end;

RenderProcessHandler 创建 Visitor(TElementNameVisitor)

procedure _ProcessElementsByAttribute(const aFrame: ICefFrame; aName, aAttributeName: string; aVisitor: TNotifyVisitor);
var
  a_Visitor: TElementNameVisitor;
begin
  if Assigned(aFrame) then
  begin
    a_Visitor := TElementNameVisitor.Create(aName);
    a_Visitor.AttributeName := aAttributeName;
    a_Visitor.OnFound := aVisitor;
    aFrame.VisitDom(a_Visitor);
  end;
end;

procedure _ProcessElements(const aFrame: ICefFrame; aVisitor: TNotifyVisitor);
var
  a_Visitor: TElementNameVisitor;
begin
  if Assigned(aFrame) then
  begin
    a_Visitor := TElementNameVisitor.Create('');
    a_Visitor.OnVisited := aVisitor;
    aFrame.VisitDom(a_Visitor);
  end;
end;

然后，访问者 (TElementNameVisitor) 将一条消息发送回 TChromium，您可以将其绑定(bind)到其中，如下所示:

procedure TformBrowser.Chromium1ProcessMessageReceived(Sender: TObject;
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage; out Result: Boolean);
var
  a_List: ICefListValue;
begin
  if SameText(message.Name, 'domdata') then
  begin
   a_List := message.ArgumentList;
   lbFrames.Items.Add(a_List.GetString(Ord(atNodeName)));
   lbFrames.Items.Add('Name: ' + a_List.GetString(Ord(atName)));
   lbFrames.Items.Add('Id: ' + a_List.GetString(Ord(atId)));
   lbFrames.Items.Add('Class: ' + a_List.GetString(Ord(atClass)));
   lbFrames.Items.Add('Level: ' + IntToStr(a_List.GetInt(Ord(atLevel))));
   lbFrames.Items.Add('------------------');
   Result := True;
  end else
  if SameText(message.Name, cdomdataFin) then
  begin
    FLoaded := True;
  end else
  begin
    lbFrames.Items.Add('Unhandled message: ' + message.Name);
    inherited;
  end;
end;

------------编辑-------------

查看此代码后...它可以改进...更加线程友好

删除这个

var
  _Browser: ICefBrowser;

改变这个

  TNotifyVisitor = procedure(aBrowser: ICefBrowser; aNode: ICefDomNode; var aLevel: integer);// of object;

将其添加到 TElementNameVisitor

property Browser: ICefBrowser read getBrowser write FBrowser;

将 TElementNameVisitor 中的引用更改为浏览器也会添加此

function TElementNameVisitor.getBrowser: ICefBrowser;
begin
  if not Assigned(FBrowser) then
    Raise Exception.Create('Need to set the Browser property when creating TElementNameVisitor.');
  Result := FBrowser;
end;

更改这些

procedure _ProcessElementsByAttribute(const aBrowser: ICefBrowser; aName, aAttributeName: string; aVisitor: TNotifyVisitor);
var
  a_Visitor: TElementNameVisitor;
begin
  if Assigned(aBrowser) and Assigned(aBrowser.MainFrame) then
  begin
    a_Visitor := TElementNameVisitor.Create(aName);
    a_Visitor.Browser := aBrowser;
    a_Visitor.AttributeName := aAttributeName;
    a_Visitor.OnFound := aVisitor;
    aBrowser.MainFrame.VisitDom(a_Visitor);
  end;
end;

procedure _ProcessElements(const aBrowser: ICefBrowser; aVisitor: TNotifyVisitor);
var
  a_Visitor: TElementNameVisitor;
begin
  if Assigned(aBrowser) and Assigned(aBrowser.MainFrame) then
  begin
    a_Visitor := TElementNameVisitor.Create('');
    a_Visitor.Browser := aBrowser;
    a_Visitor.OnVisited := aVisitor;
    aBrowser.MainFrame.VisitDom(a_Visitor);
  end;
end;

同时更改这些

procedure _ElementCB(aBrowser: ICefBrowser; aNode: ICefDomNode; var aLevel: integer);
var
  a_message: ICefProcessMessage;
begin
  a_message := TCefProcessMessageRef.New(cdomdata);
  a_message.ArgumentList.SetString(Ord(atNodeName), aNode.Name);
  a_message.ArgumentList.SetString(Ord(atName), aNode.GetElementAttribute('name'));
  a_message.ArgumentList.SetString(Ord(atId), aNode.GetElementAttribute('id'));
  a_message.ArgumentList.SetString(Ord(atClass), aNode.GetElementAttribute('class'));
  a_message.ArgumentList.SetInt(Ord(atLevel), aLevel);

  aBrowser.SendProcessMessage(PID_BROWSER, a_message);
end;

function TCustomRenderProcessHandler.OnProcessMessageReceived(
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage): Boolean;
var
  a_list: ICefListValue;
begin
  Result := False;
  if SameText(message.Name, 'ByAll') then
  begin
    _ProcessElements(browser, _ElementCB);
    Result := True;
  end else
  if SameText(message.Name, 'ByName') then
  begin
    a_list := message.ArgumentList;
    _ProcessElementsByAttribute(browser, a_list.GetString(0),'name', _ElementCB);
    Result := True;
  end else
  if SameText(message.Name, 'ById') then
  begin
    a_list := message.ArgumentList;
    _ProcessElementsByAttribute(browser, a_list.GetString(0), 'id', _ElementCB);
    Result := True;
  end else
  if SameText(message.Name, 'ByClass') then
  begin
    a_list := message.ArgumentList;
    _ProcessElementsByAttribute(browser, a_list.GetString(0), 'class', _ElementCB);
    Result := True;
  end;
end;