In this article, I will discuss about technique to catch events happened in a web browser. I wrote this article to answer a question posted by Johan Max at Delphindo about how to get notified when an anchor tag in a HTML document is clicked and also how to retrieve URL pointed by the anchor.
Of course we use our favourite tool..Delphi. This tutorial only assumes web browser is IE, for other web browsers, this technique may not work. Source code is available for download here.
Required unit.
First, import ActiveX MSHTML. If you already have MSHTML.pas or MSHTML_TLB.pas file on your system (look for it in Imports directory in your Delphi installation directory), it means you are ready to continue reading this article.
Step by step to monitor web browser events.
- Create event sink implementation.
- Load HTML document until it is complete.
- Get HTML elements to monitor.
- Connect event sink to HTML elements.
If you reach fourth step, then your application is ready to catch web browser events. When you want to stop monitoring events, last step is
- Disconnect event sink.
Ok, let us discuss it one by one.
Creating event sink implementation
Event sink must be derived from IDispatch interface, because Invoke() will be called each time event occur. Following code snippet is IDispatch declaration (unit system.pas).
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;All four methods must be implemented. IDispatch is derived from IUnknown, so we also need to implement IUnknown method. To avoid need to implement IUnknown, we can derived our implementation class from TInterfacedObject. Please note that, except Invoke(), other methods are less relevant to our goal, so we can set it unimplemented. Code snippet is as follow:
unit ueventsink;
interface
uses classes,windows,sysutils,mshtml;
type
IEventSink=interface(IDispatch)
['{AC8E45D3-DABB-4DC0-AD94-D53FA67DD78A}']
procedure SetOnClick(const Value: THTMLElementOnClick);
function GetOnClick: THTMLElementOnClick;
procedure SetWebBrowser(const Value: IWebBrowser2);
function GetWebBrowser: IWebBrowser2;
property OnClick:THTMLElementOnClick read GetOnClick
write SetOnClick;
property WebBrowser:IWebBrowser2 read GetWebBrowser
write SetWebBrowser;
end;
TEventSink=class(TInterfacedObject,IDispatch,IEventSink)
public
procedure SetOnClick(const Value: THTMLElementOnClick);
function GetOnClick: THTMLElementOnClick;
procedure SetWebBrowser(const Value: IWebBrowser2);
function GetWebBrowser: IWebBrowser2;
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;
implementation
{ TEventSink }
function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
result:=E_NOTIMPL;
end;
function TEventSink.GetTypeInfo(Index,
LocaleID: Integer;
out TypeInfo): HResult;
begin
result:=E_NOTIMPL;
end;
function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
result:=E_NOTIMPL;
end;
function TEventSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer;
Flags: Word; var Params;
VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
end;
end.We will only pay attention to Invoke() implementation. Ok, now add an event property to TEventSink class.
type
THTMLElementOnClick=procedure (Sender:TObject; Element:IHTMLElement;
var cancel:boolean) of object; Add in published part, following code
property
OnClick:THTMLElementOnClick; Press Shift+Ctrl+C to complete class declaration. This is Invoke() implementation.
function TEventSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var cancel:boolean;
begin
case dispID of
-600:begin
if Assigned(FOnClick) then
begin
cancel:=false;
FOnClick(self,nil,cancel);
end;
end;
end;
result:=S_OK;
end;Connection code implementation.
To connect to HTML elements, we need to get connection Point of the element, then callAdvise(). This is way to connect:
function ConnectEvSink(elem:IHTMLElement;eventGUID:TGUID;
eventSink:IUnknown):integer;
var cpc:IConnectionPointContainer;
cp:IConnectionPoint;
begin
result:=0;
elem.QueryInterface(IConnectionPointContainer,cpc);
if cpcnil then
begin
cpc.FindConnectionPoint(eventGUID,cp);
if cpnil then
cp.Advise(eventSink,result);
end;
end;elem is HTML element to monitor. EventGUID is GUID of event to monitor. For example to monitor anchor element then eventGUID must be set to DIID_HTMLAnchorEvents. EventSink is event sink implementation we create. Function above will return ID which later we can use to disconnect event sink.
Disconnect Event Sink
It is similar with connect, but we useUnAdvice() method.
procedure DisconnectEvSink(elem:IHTMLElement;eventGUID:TGUID;
const ID:integer);
var cpc:IConnectionPointContainer;
cp:IConnectionPoint;
begin
elem.QueryInterface(IConnectionPointContainer,cpc);
if cpcnil then
begin
cpc.FindConnectionPoint(eventGUID,cp);
if cpnil then
cp.UnAdvise(id);
end;
end;Main application implementation.
Following code get called when an achor is clicked.
procedure TForm1.AnchorClick(Sender:TObject;
Element:IHTMLElement;
var cancel:boolean);
begin
if element<>nil then
begin
ShowMessage('Link diklik.');
end;
end;Constructor is doing event sink initialization.
constructor TForm1.Create(AOWner: TComponent);
begin
inherited;
eventSink:=TEventSink.Create;
eventSink.WebBrowser:=WebBrowser1;
eventSink.OnClick:=AnchorClick;
end;Because HTML elements can be accessed after document is complete, you should process elements in DocumentComplete event.
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var doc:IHTMLDocument;
doc2:IHTMLDocument2;
i:integer;
anchors:IHTMLElementCollection;
anchor:IHTMLElement;
begin
if WebBrowser1.Document<>nil then
begin
WebBrowser1.Document.QueryInterface(IHTMLDocument,doc);
if doc<>nil then
begin
doc.QueryInterface(IHTMLDocument2,doc2);
if doc2<>nil then
begin
anchors:=GetAllAnchors(doc2);
//proses tiap link yang ada
for i:=0 to anchors.length-1 do
begin
anchor:=anchors.item(i,0) as IHTMLElement;
ConnectEvSink(anchor,DIID_HTMLAnchorEvents,eventSink);
end;
end;
end;
end;
end;GetAllAnchors() function, declared in unit uhtml_utility.pas, gets all anchor in HTML document. For each element, we connect event sink to let us get notified when events generated through Invoke().
Get element that throws event.
Invoke() code above, is unable to tell you what element generate event. Now what? IHTMLWindow2 interface has event property that represents event currently generated. From this property, we can know what element generate event, through src_Element property of event. Event aslo has returnValue property which we can use to continue or abort default action of element.
So how to get IHTMLWindow2 interface? The answer is through IHTMLDocument2.parentWindow. This is updated Invoke():
function TEventSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var cancel:boolean;
begin
case dispID of
-600:begin
if Assigned(FOnClick) then
begin
cancel:=false;
elemen:=nil;
if FWebBrowser<>nil and
FWebBrowser.Document<>nil then
begin
doc:=FWebBrowser.Document as IHTMLDocument2;
window:=doc.parentWindow;
if (window<>nil) and
(window.event<>nil) then
elemen:=window.event.src_Element;
end;
FOnClick(self,nil,cancel);
if (window<>nil) and
(window.event<>nil) then
window.event.returnValue:=cancel;
end;
end;
end;
result:=S_OK;
end;We change AnchorClick, everytime anchor gets clicked, URL is also displayed. We set cancel sama variable equal to true to cancel default action of anchor tag i.e navigate to URL specified.
procedure TForm1.AnchorClick(Sender:TObject;
Element:IHTMLElement;
var cancel:boolean);
var anchor:IHTMLAnchorElement;
url:wideString;
begin
if element<>nil then
begin
anchor:=element as IHTMLAnchorElement;
url:='URL='+anchor.href;
end else
url:='';
ShowMessage('Link diklik.'+url);
//batalkan aksi defaultnya
cancel:=true;
end;Ok that's all. Source code is available for download here.
