Tipy a triky v Delphi, díl 134. - dolujeme Internet Explorer

Dnes si opět budeme hrát s OLE a tentokrát bude cílem Internet Explorer. S jeho pomocí se naučíme získat ze zadané webové stránky všechny odkazy, které obsahuje.

Bez zbytečných úvodů se pustíme hned do práce. Cílem našeho dnešního snažení bude jednoduchá aplikace, jejíž hlavní formulář obsahuje pouze tlačítko, ListBox a Edit. Do editačního pole vložíme webovou adresu, tlačítkem ji odešleme a v ListBoxu se nám postupně zobrazí všechny odkazy, které na dané stránce jsou.

Nejprve tedy založíme nový projekt a uložíme jej. V následujícím kroku potřebujeme importovat HTML knihovnu. V menu Project vybereme položku Import Type Library. V zobrazeném seznamu najdeme a označíme položku Microsoft Object HTML Library a klikneme na tlačítko Create Unit. Nyní musíte být trpěliví, protože import knihovny a tvorba unitu chvíli potrvá. Výsledný soubor MSHTML_TLB.pas má úctyhodnou velikost 12 MB a bude automaticky přidán do našeho projektu. I následná (první) kompilace bude kvůli velikosti knihovny poněkud delší než obvykle, ale je to jen pro poprvé a nemusíte se samozřejmě ani bát velikosti výsledného exe souboru (s velikostí importované knihovny moc nesouvisí a je tak velký jako obvykle).

Když se nám podařilo úspěšně importovat HTML knihovnu, můžeme se pustit do práce. Základem je funkce WebBrowserDocumentComplete, která je aktivovaná po načtení celého dokumentu a obsahuje většinu kódu našeho příkladu. Princip je vlastně jednoduchý. Stránku rozdělíme na jednotlivé elementy a z nich si odfiltrujeme pouze tagy A. Ty pak rozdělíme na část s popisem a část s vlastní adresou a přidáme do připraveného ListBoxu.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FInternetExplorer: TInternetExplorer;
    procedure WebBrowserDocumentComplete(Sender: TObject; var pDisp: OleVariant; var URL: OleVariant);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses MSHTML_TLB, ComObj;

{$R *.dfm}

procedure TForm1.WebBrowserDocumentComplete(Sender: TObject; var pDisp: OleVariant; var URL: OleVariant);
var
  Doc: IHTMLDocument2;
  ElementCollection: IHTMLElementCollection;
  HtmlElement: IHTMLElement;
  I: Integer;
  AnchorString: string;
begin
  ListBox1.Clear;
  Doc := FInternetExplorer.Document as IHTMLDocument2;
  if Doc = nil then raise Exception.Create(`Chyba pri nacitani dokumentu!`);
  ElementCollection := Doc.all;
  for I := 0 to ElementCollection.length - 1 do
  begin
    HtmlElement := ElementCollection.item(I, ``) as IHTMLElement;
    if HTMLElement.tagName = `A` then
    begin
      AnchorString := HtmlElement.innerText;
      if AnchorString = `` then AnchorString := `(bez titulku)`;
      AnchorString := AnchorString + ` -  ` + (HtmlElement as IHTMLAnchorElement).href;
      ListBox1.Items.Add(AnchorString);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FInternetExplorer := TInternetExplorer.Create(Self);
  FInternetExplorer.OnDocumentComplete := WebBrowserDocumentComplete;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FInternetExplorer.Navigate(Edit1.Text, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
end;

end.

Jak vidíte, příklad by se dal snadno upravit pro odfiltrování libovolného tagu prostou úpravou řetězce u podmínky HTMLElement.tagName.

Po spuštění tedy stačí do připraveného Editu vložit webovou adresu, stisknout tlačítko a po nějakém čase (stránka se musí načíst a zpracovat) se do připraveného ListBoxu vypíše seznam všech odkazů na dané stránce, přičemž odkazy budou rozděleny na titulkovou část a vlastní odkaz.

Diskuze (4) Další článek: Nové paměti s taktem 550 MHz

Témata článku: Software, Internet Explorer, Programování, Díl, Unity, Unit, Trik, TRI, Dol, .doc, DEL


Určitě si přečtěte

Starlink podle betatesterů: Rychlejší a levnější než satelitní internet v Česku

Starlink podle betatesterů: Rychlejší a levnější než satelitní internet v Česku

** Reddit se začíná plnit zkušenostmi se Starlinkem ** Při přímé viditelnosti dá i 120 Mb/s ** Klasický satelitní internet už teď dalece překonává

Jakub Čížek | 41

Co je to UWB? Nová technologie zastoupí Wi-Fi, Bluetooth i NFC a slibuje velké věci

Co je to UWB? Nová technologie zastoupí Wi-Fi, Bluetooth i NFC a slibuje velké věci

** V nových mobilech se začíná objevovat tajemná zkratka UWB ** Jde o další technologii, jak navzájem propojit různá zařízení ** Oproti Wi-Fi a Bluetooth má řadu výhod

Lukáš Václavík | 35

Jak se šíří Covid v Česku: Čerstvá data, mapy okresů a obcí. Každý den aktualizované grafy

Jak se šíří Covid v Česku: Čerstvá data, mapy okresů a obcí. Každý den aktualizované grafy

** Vývoj COVID-19 v Česku: nakažení, úmrtí, testovaní, hospitalizovaní ** Mapa podle okresů, přehled podle věku, situace v Evropě i ve světě ** Každý den aktualizované grafy a mapy

Marek Lutonský | 169

Nejjednodušší cesta, jak nepřijít o data: nastavte si zálohování a zapomeňte

Nejjednodušší cesta, jak nepřijít o data: nastavte si zálohování a zapomeňte

** Přijít o důležitá data je jednodušší, než si umíte představit ** To, zda a jak snadno je získáte zpět, záleží především na vás ** Když si nastavíte zálohování, může to být otázka několik minut

Karel Kilián | 33

Není jen Flightradar: Našli jsme další aplikace pro sledování letadel, některé ukážou i víc

Není jen Flightradar: Našli jsme další aplikace pro sledování letadel, některé ukážou i víc

** 8 služeb pro sledování leteckého provozu ** Nejznámější je Flightradar24, ale alternativy leckdy prozradí více ** Letadla i v této pohnuté době čile létají a je co pozorovat

Karel Kilián | 14

10 míst na mapách Googlu, která nesmíte vidět. Nahradily je čtverečky

10 míst na mapách Googlu, která nesmíte vidět. Nahradily je čtverečky

** Deset míst, které nesmíte vidět ve webových mapách ** Jsou to letiště, základny i elektrárny ** Nejvíce míst tají Francie

Jakub Čížek | 21


Aktuální číslo časopisu Computer

Megatest mobilů do 5 500 Kč

Test levných herních notebooků

Hrajeme na Xbox Series X

Programy pro kontrolu dětí na počítači