Vyplňování formulářů v IE

I teď budeme ještě trápit Internet Explorer a ukážeme si něco více praktického. Tentokrát to bude vyplnění formuláře, umístěného na stránce, a jeho odeslání stiskem příslušného tlačítka.

Vše je krásně vidět ze zdrojového kódu. Pro náš dnešní příklad tedy umístíme na formulář komponentu WebBrowser a dvě tlačítka. V události OnClick prvního tlačítka zajistíme, že bude do komponenty WebBrowser načtena příslušná stránka. V našem případě je to titulní stránka známého vyhledavače Google. Druhým tlačítkem pak zařídíme vyplnění vyhledávacího editačního pole slůvkem „Delphi“ a poté nasimulujeme stisk tlačítka „Vyhledat Googlem“. Pokud vše proběhlo v pořádku, bude výsledný efekt stejný, jako kdybychom stejnou věc udělali ručně, a bude spuštěno vyhledávání a následné zobrazení stránky s výsledkem.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Webbrowser1.Navigate('http://www.google.com');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ShellWindow: IShellWindows;
  WB: IWebbrowser2;
  spDisp: IDispatch;
  IDoc1: IHTMLDocument2;
  Document: Variant;
  k, m: Integer;
  ovElements: OleVariant;
  i: Integer;
begin
  ShellWindow := CoShellWindows.Create;
  for k := 0 to ShellWindow.Count do
  begin
    spDisp := ShellWindow.Item(k);
    if spDisp = nil then Continue;
    spDisp.QueryInterface(iWebBrowser2, WB);
    if WB <> nil then
    begin
      WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
      if iDoc1 <> nil then
      begin
        WB := ShellWindow.Item(k) as IWebbrowser2;
        begin
          Document := WB.Document;
          for m := 0 to Document.forms.Length - 1 do
          begin
            ovElements := Document.forms.Item(m).elements;
            for i := 0 to ovElements.Length - 1 do
            begin
              try
                if (CompareText(ovElements.item(i).tagName, 'input') = 0) and (CompareText(ovElements.item(i).type, 'text') = 0) then
                  ovElements.item(i).Value := 'Delphi';
              except
              end;
              try
                if (CompareText(ovElements.item(i).tagName, 'input') = 0) and (CompareText(ovElements.item(i).type, 'submit') = 0) and (ovElements.item(i).Value = 'Vyhledat Googlem') then
                  ovElements.item(i).Click;
              except
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

end. 

Důležité upozornění se týká komponenty WebBrowser. Aby příklad fungoval, nesmíte zapomenout nastavit v Object Inspectoru vlastnost RegisterAsBrowser na True, jinak nebude okno komponenty bráno jako prohlížeč a příklad jej bude ignorovat.

Pokud budete chtít ověřit funkčnost i na Internet Exploreru, musíte jej nejprve ručně spustit a rovněž přejít na stránku Google. Když poté aktivujete funkci našeho dnešního příkladu, bude spuštěno vyhledávání jak v samotném IE, tak v komponentě WebBrowser.