1. 技术文章
  2. Delphi Chromium - Iterate DOM

Delphi Chromium - Iterate DOM

由 你说的曾经没有我的故事 提交于 2020-01-21 08:45:08

问题


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.

回答1:


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

In your DPR you should have code like this

  if not CefLoadLibDefault then
    Exit;

in your pas file

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;

You'll need to create a RenderProcessHandler:

initialization
  CefRenderProcessHandler := TCustomRenderProcessHandler.Create;

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;

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;

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;

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

Delete this

var
  _Browser: ICefBrowser;

change this

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

add this to TElementNameVisitor

property Browser: ICefBrowser read getBrowser write FBrowser;

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;

Change these

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;

Also change these

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;


来源：https://stackoverflow.com/questions/34655862/delphi-chromium-iterate-dom

标签
Delphi
delphi-2007
chromium-embedded
tchromium
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!