Delphi Chromium - Iterate DOM - Отличная библиотека

Я пытаюсь выполнить итерацию DOM с помощью TChromium, и поскольку я использую Delphi 2007, я не могу использовать анонимные методы, поэтому я создал класс, унаследованный от TCEFDomVisitorOwn. Мой код выглядит следующим образом, но по какой-то причине процедура «посещения» никогда не вызывается, поэтому ничего не происходит.Delphi Chromium - Iterate DOM

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.

источник

2016-01-07 delphirules

Вы видели [это] (http://stackoverflow.com/а/10673526/800214)? – whosrdaddy

@whosrdaddy Да, мой код очень похож на этот, но почему-то мой не работает, процедура посетителя никогда не называется. – delphirules

Все дело в отправке сообщений туда и обратно. В вашем коде отсутствует RenderProcessHandler, это позволяет Renderer получать сообщения.

В вашей ДПР вы должны иметь код, как этот

if not CefLoadLibDefault then 
    Exit;

в ваших па файл

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 в браузере также добавить

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;

источник

2016-01-20 23:10:19

Это было протестировано и запущено в Delphi 6;) –

Delphi Chromium - Iterate DOM

ответ

Смежные вопросы