Delphi Chromium — итерация DOM

Я пытаюсь выполнить итерацию DOM с помощью TChromium, и, поскольку я использую 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.

delphi chromium-embedded delphi-2007 tchromium
person delphirules    schedule 07.01.2016    source источник
comment
Вы видели это?   -  person whosrdaddy    schedule 07.01.2016
comment
@whosrdaddy да, мой код очень похож на этот, но почему-то мой не работает, процедура посетителя никогда не вызывается.   -  person delphirules    schedule 07.01.2016

Ответы (1)


arrow_upward
4
arrow_downward

Все дело в отправке сообщений туда и обратно. В вашем коде отсутствует 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;

Чтобы использовать его... Вы отправляете сообщение Renderer, как это

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;

Затем посетитель (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 на Browser, также добавьте это

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;
person House of Dexter    schedule 20.01.2016
comment
Это было протестировано и работает в Delphi 6;) - person House of Dexter; 21.01.2016