delphi dom html,Delphi Chromium - Iterate DOM

本文详细介绍了如何在Chromium浏览器中实现消息的双向传递,包括创建RenderProcessHandler以允许渲染进程接收消息的具体实现方法。通过示例代码展示了如何从主线程发送消息到渲染线程,并从渲染线程回调主线程。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

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;

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值