Tipy a triky v Delphi, díl 173. – WebBrowser a zóny

Dnes opustíme na čas téma DLL knihoven a podíváme se opět po čase na komponentu WebBrowser. Tentokrát budeme zkoumat, do jaké zóny patří načtený dokument.

Používáte-li Internet Explorer, jistě víte, že se na stavovém řádku okna zobrazuje informace o tom, v jaké zóně se právě nacházíme. Může to být Internet, Tento počítač, Místní intranet a další možnosti. Kromě popisu má každá zóna i svou ikonu. Z komponenty WebBrowser pochopitelně tyto údaje lze pro načtený dokument získat rovněž, neboť se prakticky jedná o Internet Explorer. A právě to se dnes naučíme.

Naše aplikace bude velmi jednoduchá. Na prázdný formulář nejprve umístíme komponentu WebBrowser, dále Edit, tlačítko, Image a dvakrát Label. Aplikace bude pracovat tak, že po zadání požadované adresy (lokálního dokumentu či webové adresy) do Editu a odeslání stiskem tlačítka bude dokument načten do WebBrowseru a poté se zobrazí název zóny (první Label) a její popis (druhý Label). Do komponenty Image se pak načte příslušející ikona.

Důležitý je pro nás unit URLMon, ve kterém je definován typ TZoneAttributes, který potřebné údaje popisuje. S využitím dalších funkcí tohoto unitu pak získáme požadovaná data včetně ikony. Po načtení dokumentu je v události OnNavigateComplete2 spuštěna celá akce.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1NavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure GetZoneIcon(IconPath: string; var Icon: TIcon);
var
  FName, ImageName: string;
  h: hInst;
begin
  FName := Copy(IconPath, 1, Pos(`#`, IconPath) - 1);
  ImageName := Copy(IconPath, Pos(`#`, IconPath), Length(IconPath));
  h := LoadLibrary(Pchar(FName));
  try
    if h <> 0 then Icon.Handle := LoadImage(h, Pchar(ImageName), IMAGE_ICON, 16, 16, 0);
  finally
    FreeLibrary(h);
  end;
end;

function GetZoneAttributes(const URL: string): TZoneAttributes;
var
  dwZone: Cardinal;
  ZoneAttr: TZoneAttributes;
var
  ZoneManager: IInternetZoneManager;
  SecManager: IInternetSecurityManager;
begin
  ZeroMemory(@ZoneAttr, SizeOf(TZoneAttributes));
  if CoInternetCreateSecuritymanager(nil, SecManager, 0) = S_OK then
    if CoInternetCreateZoneManager(nil, ZoneManager, 0)  = S_OK then
    begin
      SecManager.MapUrlToZone(PWideChar(WideString(URL)), dwZone, 0);
      ZoneManager.GetZoneAttributes(dwZone, Result);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var
  ZoneAttr: TZoneAttributes;
  ZoneIcon: TIcon;
begin
  ZoneAttr := GetZoneAttributes(Webbrowser1.LocationURL);
  ZoneIcon := TIcon.Create;
  try
    GetZoneIcon(ZoneAttr.szIconPath, ZoneIcon);
    Label1.Caption := ZoneAttr.szDisplayName;
    Label2.Caption := ZoneAttr.szDescription;
    Image1.Picture.Icon := ZoneIcon;
  finally
    ZoneIcon.Free;
  end;
end;

end.

A k čemu nám tahle informace vlastně může sloužit? Určitě na něco přijdete sami. V dnešních aplikacích je často integrován nějaký miniprohlížeč (kupříkladu pro zobrazení stránek výrobce programu) a kontrolovat, ve které zóně se pohybujeme, může být užitečné třeba z bezpečnostních důvodů.

To bude pro dnešek vše. Jako obvykle, ukázkový projekt můžete stahovat zde.

Diskuze (2) Další článek: Karneval zlevnil a zrychlil

Témata článku: Software, Programování, Internet Explorer, Zóna, TRI, DEL, Label, Trik, Unit, Díl, Icon, Copy, Unity



Týden mobilně: Přichází soumrak, anebo úsvit kompaktních telefonů?
Jan LáskaMartin Miksa
Kompaktní velikostTýden mobilně
25 nejlepších filmových parodií, které můžete vidět. Víme, kde je najdete online

25 nejlepších filmových parodií, které můžete vidět. Víme, kde je najdete online

Filmové parodie jsou divácky velmi vděčné a mezi filmaři oblíbené. Tvůrci v nich mohou totiž zcela beztrestně vykrádat cizí díla a v jejich nápodobě popustit uzdu své fantazii. Vybrali jsme nejlepší zahraniční i české parodie.

Jaromír PukMarek Čech
Filmy, které musíte vidět
Čeština v Ubuntu je ohrožena, komunita přišla o překladatele
Lukáš Václavík
UbuntuOperační systémyLinux