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

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.