A Delphi programozási nyelv

TWebbrowser komponens

TWebbrowser komponens

  A TWebbrowser a Microsoft Internet Explorerének ActiveX komponense, melynek használatával alkalmazásunkban megjeleníthetünk weblapokat, megtekinthetünk különböző fájlokat, könyvtárak tartalmát. Röviden egy komplett böngészőt integrálhatunk programunkba.

    

A Microsoft Webbrowser komponens részletes ismertetése megtalálható a Microsoft Developer Network oldalán (http://msdn.microsoft.com/en-us/library/aa752040(VS.85).aspx).

TWebbrowser komponens telepítése

  A Delphi 5.0 változattól már az alapcsomag részét képezi, azonban a „gyári” komponenst célszerű eltávolítani, mert az még egy régebbi Internet Explorer változatát tartalmazza. A Delphiben a Component - Install package... menü választása után a megjelenő ablakban a Design packages közül keressük meg az Internet Explorer Components sort, majd kattintsunk a Remove gombra.

  Az új TWebbrowser komponens telepítéséhez a következő lépéseket kell végrehajtani: Component - Import ActiveX control... menü kiválasztása, majd a megjelenő ablakban a Microsoft Internet Controls sort kiválasztva kattintsunk az Install… gombra. Ennek hatására az ActiveX fülön létrejön 2 új komponens - a TWebbrowser és a TWebbrowser_V1, valamint elkészült a SHDocVw_TLB.pas fájl is. Ebből a két komponensből bennünket csak a TWebbrowser fog érdekelni. A TWebbrowser_V1 az IE 3.0-ás változatáig, míg az IE 4.0-ás változattól már a TWebbrowser komponens használandó. Jelenleg a legtöbb gépen már az Internet Explorer 8.0-s verziója található. A TWebbrowser komponensünk is a gépünkön lévő Internet Explorer verziójával lesz kompatibilis.

  A TWebbrowser komponens telepítésén túl szükségünk lehet még a MSHTML_TLB.pas fájlra is, melyet a következő módon készíthetünk el. Component - Import ActivX control… - Microsoft HTML Object Library kiválasztása után kattintsunk a Create Unit gombra.

TWebbrowser komponens használata

  Most már képesek vagyunk megírni életünk első böngésző programját. Hozzunk létre egy új alkalmazást, a formra helyezzünk ki egy TWebbrowser komponenst WB néven, igazítsuk a megfelelő méretre, helyezzünk el egy TButtont Button néven, majd írjuk meg a ButtonOnClick eseményt.

procedure ButtonClick(Sender: TObject);
begin
	WB.Navigate('http://inf.elte.hu');
end;

vagy használhatjuk a Navigate2 eljárást a következő módon.

procedure TForm1.ButtonClick(Sender: TObject);
var URL : OleVariant
begin
	URL := 'http://inf.elte.hu';
	WB.Navigate2(URL);
end;

  Az alkalmazást futtatva és a Buttonra kattintva megjelenik a 'http://inf.elte.hu' oldal. Az oldalon kattinthatunk a linkekre, használhatjuk a jobb oldali egérgomb megnyomásakor megjelenő menüket, használhatjuk a fontosabb navigáló billentyűket (Alt + Balra, Alt + Jobbra, F5 stb.). Tehát pár sor megírásával elkészítettünk egy majdnem komplett böngésző programot. Természetesen nem csak weboldalak megtekintésére alkalmas a TWebbrowser komponens, hanem mappák ('file://c:\'), fájlok ('file://c:\a.txt') megjelenítésére is. Segítségével akár FTP-zhetünk is ('ftp://……').

  Használhatjuk a Drog&Drop funkciót is. Egyszerűen az egérrel húzzunk rá egy fájlt vagy egy parancsikont és az rögtön megjelenik.

  Egy TWebbrowser komponens használatának egyik legfontosabb eljárása a Navigate és a Navigate2. Ezek paraméterezésének részletes leírása megtalálható a http://msdn.microsoft.com/en-us/library/aa752093(VS.85).aspx oldalon.

TWebbrowser komponens fontosabb eseményei

A Navigate vagy Navigate2 eljárással elkezdődik a megadott oldal betöltése. Betöltés alatt számos esemény lekezelésére van lehetőségünk.

BeforeNavigate2 = procedure(Sender: TObject;
                            const pDisp: IDispatch; 
                            var URL: OleVariant; 
                            var Flags: OleVariant; 
                            var TargetFrameName: OleVariant; 
                            var PostData: OleVariant; 
                            var Headers: OleVariant; 
                            var Cancel: WordBool) of object;
CommandStateChange = procedure(Sender: TObject;
			       Command: Integer;
			       Enable: WordBool) of object;
DocumentComplete = procedure(Sender: TObject;
			     const pDisp: IDispatch; 
			     var URL: OleVariant) of object;
NewWindow2 = procedure(Sender: TObject;
		       var ppDisp: IDispatch; 
		       var Cancel: WordBool) of object;
ProgressChange = procedure(Sender: TObject;
			   Progress: Integer;
			   ProgressMax: Integer) of object;
StatusTextChange = procedure(Sender: TObject;
			     const Text: WideString) of object;
TitleChange = procedure(Sender: TObject;
			const Text: WideString) of object;

TWebbrowser fontosabb metódusai

procedure GoBack;
procedure GoForward;
procedure GoHome;
procedure GoSearch;
procedure Refresh;
procedure Stop;
procedure ExecWB(cmdID: OLECMDID;
		 cmdexecopt: OLECMDEXECOPT;
		 var pvaIn: OleVariant;
		 var pvaOut: OleVariant);
function  QueryStatusWB(cmdID: OLECMDID): OLECMDF;

Többablakos internet böngésző program - ElteWB

TWebbrowser komponens létrehozása futás időben

  Szinte minden információ adott, hogy elkészítsünk egy ún. többablakos böngésző alkalmazást. Ekkor azonban futásidőben kell létrehoznunk a TWebbrowser komponenseinket. Helyezzünk el a formon egy TPageControl komponenst, majd ezen hozunk létre TTabSheeteket és a TWebbrowser komponenseket. Tehát első lépésben meg kell oldani futásidőben új TWebbrowser komponens létrehozását. Ez általában két esetben fordulhat elő. Vagy a felhasználó kattint pl. az „Új lap” menüre vagy TButtonra, vagy valamelyik megjelenített weboldal akar új lapot létrehozni. Írjuk meg a NewTab eljárást, mely paraméterként a létrehozandó TTabSheet helyét határozza meg (pl. az aktuális lap után vagy utolsó lapként).

function NewTAB(where : integer) : TTabSheet;
var WB : TWebbrowser;
    TabSheet : TTabSheet;
    i : integer;
begin
	result := nil;
	try
	PageControl.OnChange := nil;
	TabSheet := TTabSheet.Create(PageControl);
	TabSheet.PageControl := PageControl;
	TabSheet.ImageIndex := -1;
	TabSheet.BorderWidth := 0;
	WB := TWebbrowser.Create(Application);
	TWinControl(WB).Parent := TabSheet;
	WB.Align := alClient;
	WB.OnBeforeNavigate2 := WBBeforeNavigate2; //beállítjuk az összes lekezelendő eseményt.
		try
		TabSheet.PageIndex := where+1;
		except end;
		try //beállítjuk a TabSheet-ek Caption-ját
		if PageControl.PageCount > 0 then
			begin
				for i := 0 to PageControl.PageCount-1 do
				begin
					if (not assigned((PageControl.Pages[i].Controls[0] as TWebbrowser).Document))
					    or ((PageControl.Pages[i].Controls[0] as TWebbrowser).LocationURL = 'about:blank' then
						begin
							if (PageControl.Pages[i].Controls[0] as TWebbrowser).Visible then
								PageControl.Pages[i].Caption := IntToStr(i+1)+'.';
						end;
				end;
			end;
		except end;
	PageControl.ActivePage := TabSheet;
	PageControlChange(PageControl);
	PageControl.Refresh;
	PageControl.OnChange := PageControlChange;
	result := TabSheet;
	except end;
end;

A fenti kódban látható, hogy a létrehozott TWebbrowser komponenst a következő módon érhetjük el:

var aBrowser : TWebbrowser;
begin
	aBrowser := (PageControl.Pages[i].Controls[0] as TWebbrowser); //az i-edik TabSheet-en lévő 
	aBrowser := (PageControl.ActivePage.Controls[0] as TWebbrowser); //az aktuális TabShet-en lévő
	.... //itt használhatom az aBrowsert pl. aBrowser.Navigate(...);
end;

Nézzük meg, hogy az OnNewWindow2 eseménynél hogyan kell használnunk az újonnan létrehozott TWebbrowser komponenst.

procedure NewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var aBrowser : TWebbrowser;
begin
	cancel := true;
	try
	aBrowser := NewTab((TWinControl(ASender).Parent as TTabSheet).PageIndex).Controls[0] as TWebbrowser;
	except end;
	if assigned(aBrowser) then
		begin
		ppDisp := aBrowser.DefaultInterface as IDispatch;
		cancel := false;
		end
end;

TWebbrowser komponens megszüntetése

Azonban egy ilyen programban nem csak létrehozni, hanem megszüntetni is tudni kell a létrehozott TWebbrowser komponenseket. A megszüntetés 2 lépésből áll. Először a bezárásra ítélt TWebbrowser komponenst el kell navigálni az „about:blank”-ra (amennyiben ezt nem tesszük meg, a megnyitott weboldalon lévő ActiveX vezérlők a bezárást követően is aktívak maradhatnak), majd ennek befejeződése után szüntethetjük meg a komponensünket. Ne felejtsük el, hagy amennyiben pl. egy TTabSheeten hoztuk létre, úgy azt is el kell távolítanunk.

procedure mnuCloseClick(Sender : TObject);
var i : integer;
begin
	CloseButton.Enabled := false;
	try
		try
		index := PageControl.ActivePageIndex;
		(PageControl.pages[index].Controls[0] as TWebbrowser).Silent := True;
		PageControl.pages[index].TabVisible := false;
		if assigned((PageControl.pages[index].Controls[0] as TWebbrowser).Document) then
			begin
			(PageControl.pages[index].Controls[0] as TWebbrowser).Navigate('about:blank');
				while (PageControl.pages[index].Controls[0] as TWebbrowser).WB.LocationURL <> 'about:blank' do
					Application.ProcessMessages;
			end;
		finally DeleteTab(PageControl.pages[index]); end;
	except end;
end;

procedure DeleteTab(TabSheet : TTabSheet);
var i, index : integer;
begin
	PageControl.OnChange := nil;
	if TabSheet = nil then TabSheet := PageControl.ActivePage;
	index := TabSheet.PageIndex;
	TabSheet.TabVisible := false;
	(TabSheet.Controls[0] as TWebbrowser).Silent := true;
	(TabSheet.Controls[0] as TWebbrowser).Free;
	TabSheet.free;
	if PageControl.PageCount > 0 then
		begin
			for i := 0 to PageControl.PageCount-1 do
				begin
					if (not assigned((PageControl.Pages[i].Controls[0] as TWebbrowser).Document))
					or ((PageControl.Pages[i].Controls[0] as TWebbrowser).LocationURL = 'about:blank') then			
						begin
							if (PageControl.Pages[i].Controls[0] as TWebbrowser).Visible then 
								PageControl.Pages[i].Caption := IntToStr(i+1)+'.';
						end;
				end;
		end
		else begin
		NewTab(-1);
		end;
	PageControlChange(PageControl);
	PageControl.Refresh;
	PageControl.OnChange := PageControlChange;
end;

Futási időben sajnos nem csak a felhasználó szüntetheti meg a meglévő TWebbrowser komponensünket, hanem a megnyitott weboldalon lévő JavaScript vagy bármely ActiveX vezérlő is. Ennek az eseménynek az „elkapása” és „felügyelete” már nem tartozik a TWebbrowser komponens bemutatásához. Ezt a WM_CLOSE esemény lekezelésével lehet megoldani. Ehhez létre kell hoznunk egy GetMsgProc eljárást, ezt beregisztrálni (SetWindowsHookEx) az alkalmazás indításakor, majd megszüntetni (UnhookWindowsHookEx) a programból való kilépéskor.

TElteWebbrowser komponens létrehozása

Térjünk vissza a programunkhoz. Hozzunk létre egy TElteWebbrowser komponenst, melyet a TWebbrowserből illetve az IDocHostUIHandler és IDispatch interfészekből származtatunk.

IDocHostUIHandler = interface(IUnknown)
['{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}']
    function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
      const CommandTarget: IUnknown; const Context: IDispatch): HRESULT;
        stdcall;
    function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject:
      IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(const prcBorder: PRECT;
      const pUIWindow: IOleInPlaceUIWindow;
      const fRameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(out pchKey: POLESTR; const dw: DWORD): HRESULT;
      stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget;
      out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
      out ppchURLOut: POLESTR): HRESULT; stdcall;
    function FilterDataObject(const pDO: IDataObject;
      out ppDORet: IDataObject): HRESULT; stdcall;
end;
IDispatch = interface(IUnknown)
['{00020400-0000-0000-C000-000000000046}']
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
end;
TElteWebbrowser = class(TWebBrowser, IDocHostUIHandler,IDispatch)
  private
    FDownloadOptionValue : longint;
  protected
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    property DownloadOptionValue : longint read FDownloadOptionValue write FDownloadOptionValue;
    function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
      const CommandTarget: IUnknown; const Context: IDispatch): HRESULT;
        stdcall;
    function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject:
      IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(const prcBorder: PRECT;
      const pUIWindow: IOleInPlaceUIWindow;
      const fRameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(out pchKey: POLESTR; const dw: DWORD): HRESULT;
      stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget;
      out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
      out ppchURLOut: POLESTR): HRESULT; stdcall;
    function FilterDataObject(const pDO: IDataObject;
      out ppDORet: IDataObject): HRESULT; stdcall;
  published
    {Published}
  end;

TElteWebbrowser.GetHostInfo

Miért vezettük be azt a két új interfészt? Az IDocHostUIHandlert azért, mert alapesetben a TWebbrowser komponens által megnyitott weboldalak a régi 4.0 verzió megjelenéséhez hasonlítanak (nyomógombok, comboboxok, szövegbeviteli mezők, kerete van a komponensnek stb.). Szeretnénk, hogy minden oldal az ún. „XP stílusban” jelenjen meg. Ezt a GetHostInfo funkció használatával tehetjük meg. A különbség, remélem, látható!

type
  TDOCHOSTUIINFO = record
    cbSize: ULONG;
    dwFlags: DWORD;
    dwDoubleClick: DWORD;
    chHostCss: POLESTR;
    chHostNS: POLESTR;
  end;
  
function TElteWebbrowser.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT;
const
  DOCHOSTUIDBLCLK_DEFAULT = 0;
  DOCHOSTUIFLAG_NO3DBORDER = $00000004;
  DOCHOSTUIFLAG_THEME = $00040000;
begin
  FillChar(pInfo, SizeOf(TDOCHOSTUIINFO), #0);
  pInfo.cbSize := SizeOf(pInfo);
  pInfo.dwFlags := DOCHOSTUIFLAG_THEME or DOCHOSTUIFLAG_NO3DBORDER;
  pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;
  Result := S_OK;
end;
  

TElteWebbrowser.Invoke

Az IDispatch interfész használatát pedig azért vezettük be, mert szeretnénk szabályozni a megjelenített (letöltött) elemeket. Pl. ne jelenjenek meg a képek, az adott oldalon ne fussanak a beépített JavaScipt eljárások (reklámok megjelenésének tiltása), ne lépjenek működésbe a különböző ActiveX vezérlők (pl. flash animációk, reklámok).

Mikor lehet erre szükség? Pl. mobil internettel netezve (korlátos, lassú) lehetőségem van szabályozni a letöltendő elemeket, ezáltal gyorsítva a böngészést és csökkenteni az adatforgalmat. Egy index.hu nyitólap akár 1-3 MB adatot is tartalmazhat, azonban pl. a JavaSriptek és az ActiveX vezérlőt tiltásával ez 200-300 KB lesz. Így ha szükséges időt és adatforgalmat takaríthatunk meg. Ezt az Invoke funkció használatával tehetjük meg.

const
  DISPID_AMBIENT_DLCONTROL = (-5512);

function TElteWebbrowser.Invoke(DispID: Integer;
  const IID: TGUID;
  LocaleID: Integer;
  Flags: Word;
  var Params;
  VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  Result := S_OK;
  if (Flags and DISPATCH_PROPERTYGET <> 0) and 
     (VarResult <> nil) and
     (DispId = DISPID_AMBIENT_DLCONTROL) then
    begin
		PVariant(VarResult)^ := fDownloadOptionValue;
    end
    else begin
    Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
	end;
end;
  

Látható, hogy a bal oldali kép felső részén egy flash reklám található, míg a jobb oladali képen ezt nem jelenítettük meg.

Letölthető fájlok

ElteWB.zip (Méret: 329 KB)

Szerző: Nagy Róbert