Delphi Chromium-迭代DOM [英] Delphi Chromium - Iterate DOM

问题描述

我试图使用TChromium来迭代DOM，并且因为我使用的是Delphi 2007，所以我无法使用匿名方法，因此我创建了一个继承自TCEFDomVisitorOwn的类。我的代码如下，但是由于某种原因，从来没有调用访问过程，因此什么也没发生。

I'm trying to iterate the DOM using TChromium and because i use Delphi 2007 i can't use anonymous methods, so i created a class inherited of TCEFDomVisitorOwn. My code is as below, but for some reason the 'visit' procedure is never called, so nothings happens.

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.

推荐答案

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

It's all about sending messages back and forth. Your code is missing a RenderProcessHandler, this allows the Renderer to receive messages.

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

In your DPR you should have code like this

  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：

You'll need to create a RenderProcessHandler:

initialization
  CefRenderProcessHandler := TCustomRenderProcessHandler.Create;

要使用它...您像这样向Renderer发送消息

To use it...You send a message to Renderer like this

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将获得以下消息：

The RenderProcessHandler will get the message:

{ 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）

The RenderProcessHandler creates the 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，您可以将其绑定为： / p>

The Visitor (TElementNameVisitor)then sends a message back to TChromium and you can tie into it like:

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;

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

-----------edit-------------

看完这段代码后...可以改进...使其对线程更友好

After looking at this code...it can be improved...to be more thread friendly

删除此

var
  _Browser: ICefBrowser;

更改此

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

将此添加到TElementNameVisitor

add this to TElementNameVisitor

property Browser: ICefBrowser read getBrowser write FBrowser;

将TElementNameVisitor中的引用更改为Browser也将其添加

Change references in TElementNameVisitor to Browser also add this

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;

这篇关于Delphi Chromium-迭代DOM的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！