Delphi Chromium - Iterate DOM - delphi

Question

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.

Answer 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;