не могу получить Элементы ... элементы веб-браузера.'A' и 'INPUT' ando и так далее ... delphi 2007 - PullRequest
2 голосов
/ 16 февраля 2012

ребята мой английский плохой , но мне нужна ваша помощь ...

Я не могу получить фреймы и элементы одним браузером, и мне нужно получить все«delphi 2007».

без этого приложения на моем компьютере я получаю все, но при установке этого приложения многие входы не назначаются.см ...

public
 doc1: IHTMLDocument2;
 Elementos: IHTMLElementCollection;
 Elemento: IHTMLElement;
end;

procedure TNavegador.wbDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL:  OleVariant);
var
 Z : Integer;
begin
 doc1 := (pDisp as IWebBrowser2).Document as IHTMLDocument2;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo3.Text := Wb.OleObject.Document.documentElement.innerText; //not assigned

 memo2.Text := doc1.body.innerHTML; // work. <-----

 Elementos := (doc1.all).tags('A') as IHTMLElementCollection; //not assigned

 if Assigned(Elementos) then
 begin
  for Z := 0 to Elementos1.length - 1 do
  begin
   Elemento := Elementos.Item(Z, 0) as IHTMLElement;
   if Assigned(Elemento) then
   begin
    if pos('/IMG/bt_voltar.gif', Elemento.innerHTML) > 0 then
    begin
     Elemento.Click; //click in link back
    end;
   end;
  end;
 end;

end;

  procedure TForm1.Button2Click(Sender: TObject);
  var
   Q : Integer;
   Elementos1: IHTMLElementCollection;
   Elemento1: IHTMLElement;
  begin
     Elementos1 := (doc1.all).tags('INPUT') as IHTMLElementCollection; //not assigned

     for Q := 0 to Elementos1.length - 1 do
     begin
      Elemento1 := Elementos1.Item(Q, 0) as IHTMLElement;
      if Assigned(Elemento1) then
      begin
       if Elemento1.getAttribute('name', 0) = 'Post_me' then
       begin
        Elemento1.setAttribute('value', '010203', 0);
       end;

       if Elemento1.getAttribute('name', 0) = 'btn_click' then
       begin
        Elemento1.Click;
       end;
      end;
     end;

   end;

function getAllInputs(doc: IHTMLDocument2): IHTMLElementCollection; //not assigned
var
 elementos: IHTMLElementCollection;
begin
 elementos := (doc.all).tags('input') as IHTMLElementCollection;
 result := elementos;
end;

function getAllLinks(doc: IHTMLDocument2): IHTMLElementCollection; //not assigned
var
 elementos: IHTMLElementCollection;
begin
 elementos := (doc.all).tags('A') as IHTMLElementCollection;
 result := elementos;
end;

Многие идеи ?????жду.

благодарю.

1 Ответ

4 голосов
/ 16 февраля 2012

Ваша проблема заключается в том, что событие OnDocumentComplete будет запущено для КАЖДОГО набора фреймов + верхнего документа. Вот пример кода, как правильно реализовать это событие:

procedure TFrm_browser.BrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);

var CurrentBrowser: IWebBrowser2;
    TopBrowser: IWebBrowser2;
    Doc :  IHTMLDocument2;

begin
  CurrentBrowser := pDisp as IWebBrowser2;
  TopBrowser := (ASender as TWebbrowser).DefaultInterface;
  if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
   begin
    Doc := CurrentBrowser.Document as IHTMLDocument2;
    if CurrentBrowser = TopBrowser then
     begin
      if Assigned(FOnCompleteDocLoaded) then
       FOnCompleteDocLoaded(Self, Doc);
     end
    else
     begin
      if Assigned(FOnFrameSetLoaded) then
       FOnFrameSetLoaded(Self, Doc);
     end;
   end;
end;

Вы должны обработать каждый набор фреймов и верхний документ.

EDIT

Поскольку в ОП нет подсказки, я создал небольшой тестовый проект:

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, StdCtrls, Mshtml;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
    procedure GetH3Tags(Doc :  IHTMLDocument2);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 WebBrowser1.Navigate('http://www.w3schools.com/tags/tryit.asp?filename=tryhtml_frame_cols');
end;

procedure TForm1.GetH3Tags(Doc: IHTMLDocument2);

var Elements: IHTMLElementCollection;
    Element : IHTMLElement;
    Index : Integer;

begin
 Elements := Doc.all.tags('h3') as IHTMLElementCollection;
 Index := Elements.length;
 while Index > 0 do
  begin
   Dec(Index);
   Element := Elements.item(Index, '') as IHTMLElement;
   Memo1.Lines.Add(Element.innerText);
  end;
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var CurrentBrowser: IWebBrowser2;
    TopBrowser: IWebBrowser2;
    Doc :  IHTMLDocument2;

begin
  CurrentBrowser := pDisp as IWebBrowser2;
  TopBrowser := (ASender as TWebbrowser).DefaultInterface;
  if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
   begin
    Doc := CurrentBrowser.Document as IHTMLDocument2;
    if CurrentBrowser = TopBrowser then
     begin
      // get tags for top level document
       GetH3Tags(Doc);
     end
    else
     begin
      // get tags for each frameset
       GetH3Tags(Doc);
     end;
   end;
end;


end.

Файл DFM:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 427
  ClientWidth = 899
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object WebBrowser1: TWebBrowser
    Left = 209
    Top = 0
    Width = 690
    Height = 427
    Align = alClient
    TabOrder = 0
    OnDocumentComplete = WebBrowser1DocumentComplete
    ExplicitLeft = 56
    ExplicitTop = 24
    ExplicitWidth = 300
    ExplicitHeight = 150
    ControlData = {
      4C00000050470000222C00000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 209
    Height = 427
    Align = alLeft
    Color = clHighlight
    TabOrder = 1
  end
end

Этот образец получит все теги H3 с этой страницы: http://www.w3schools.com/tags/tryit.asp?filename=tryhtml_frame_cols

@ Tlama: это хороший пример, когда OnDocumentcomplete будет срабатывать несколько раз.

...