Delphi Chromium - Iterate 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，这允许Renderer接收消息。

在你的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创建访问者（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;

Visitor（TElementNameVisitor）然后将一条消息发送回TChromium，您可以将其绑定为：

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;