Compile ie extension using Delphi

Is how to enable the IE extension component to respond to events.
Anyone who has used the webbrowser control in their own programs knows that the webbrowser control defines events such as beforenavigate and downloadcomplete. We can write the event processing code to perform operations on the webbrowser control. So how can we respond to and handle ie events? Same as creating an IE panel. We need to create a COM component that implements the iobjectwithsite interface. The difference is that we also need to implement the idispatch interface, in the setsite method of the iobjectwithsite interface, obtain the webbrowser interface of IE and establish the connection between itself and webbrowser. If any event occurs in the webbrowser object of IE, then ie calls back the invoke method of the connected idispatch interface. We can get the IE event by writing code in the invoke method. This uses the principle of the callback interface for COM programming.
The following code is implemented first. Click file | new in the Delphi menu. On the ActiveX page, select active library and click OK. Create a COM object in the same way. In the COM object wizard window, remove the check box included Type Library. Enter iehelper in class name and idispatch and iobjectwithsite in implemented interface. Click OK to create a COM component.
Save the project, save it as iehelper. DPR, and save unit1 as iehelperunit. Pas. The code for iehelperunit. PAS is as follows:

Unit iehelperunit;

Interface

Uses
Windows, comobj, ActiveX, shdocvw, mshtml, dialogs;

Type

Tiehelperfactory = Class (tcomobjectfactory)
Private
Procedure addkeys;
Procedure removekeys;
Public
Procedure updateregistry (register: Boolean); override;
End;

Tiehelper = Class (tcomobject, idispatch, iobjectwithsite)
Public
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, interval info, argerr: pointer): hresult; stdcall;
Function setsite (const punksite: iunknown): hresult; stdcall;
Function getsite (const riid: tiid; out site: iunknown): hresult; stdcall;
Private
IE: iwebbrowser2;
COOKIE: integer;
End;

Const
Class_iehelper: tguid = '{3d898c55-74cc-4b7c-b5f1-45913f0000388 }';

Implementation

Uses comserv, registry, sysutils;

Procedure dostatustextchange (const text: widestring );
Begin

End;

Procedure doprogresschange (Progress: integer; progressmax: integer );
Begin

End;

Procedure docommandstatechange (command: integer; Enable: wordbool );
Begin

End;

Procedure dodownloadbegin;
Begin

End;

Procedure dodownloadcomplete;
Begin

End;

Procedure dotitlechange (const text: widestring );
Begin

End;

Procedure dopropertychange (const szproperty: widestring );
Begin

End;

Procedure publish (const Pdisp: idispatch; var URL: olevariant; var flags: olevariant; var targetframename: olevariant; var postdata: olevariant; var headers: olevariant; var cancel: wordbool );
Begin
If URL <> 'HTTP: // www.applevb.com/'then begin
Showmessage ('You cannot browse other sites ');
Cancel: = true;
URL: = 'HTTP: // www.applevb.com ';
(Pdisp as iwebbrowser2). navigate2 (URL, flags, targetframename, postdata, headers );
End;
End;

Procedure donewwindow2 (VAR ppdisp: idispatch; var cancel: wordbool );
Begin

End;

Procedure donavigatecomplete2 (const Pdisp: idispatch; var URL: olevariant );
Begin

End;

Procedure dodocumentcomplete (const Pdisp: idispatch; var URL: olevariant );
Begin

End;

Procedure doonquit;
Begin

End;

Procedure doonvisible (visible: wordbool );
Begin

End;

Procedure doontoolbar (toolbar: wordbool );
Begin

End;

Procedure doonmenubar (menubar: wordbool );
Begin

End;

Procedure doonstatusbar (statusbar: wordbool );
Begin

End;

Procedure doonfullscreen (fullscreen: wordbool );
Begin

End;

Procedure doontheatermode (theatermode: wordbool );
Begin

End;

Procedure buildpositionaldispids (pdispids: pdispidlist; const DPS: tdispparams );
VaR
I: integer;
Begin
Assert (pdispids <> nil );
For I: = 0 to DPs. cargs-1 do
Pdispids ^ [I]: = DPS. cargs-1-I;
If (DPS. cnamedargs <= 0) Then exit;
For I: = 0 to DPs. cnamedargs-1 do
Pdispids ^ [DPS. rgdispidnamedargs ^ [I]: = I;
End;

Function tiehelper. Invoke (dispid: integer; const IID: tguid; localeid: integer;
Flags: word; var Params; varresult, raise info, argerr: pointer): hresult;
Type
Polevariant = ^ olevariant;
VaR
DPS: tdispparams absolute Params;
Bhasparams: Boolean;
Pdispids: pdispidlist;
Idispidssize: integer;
Begin
Result: = disp_e_membernotfound;
Pdispids: = nil;
Idispidssize: = 0;
Bhasparams: = (DPS. cargs> 0 );
If (bhasparams) then
Begin
Idispidssize: = DPS. cargs * sizeof (tdispid );
Getmem (pdispids, idispidssize );
End;
Try
If (bhasparams) Then buildpositionaldispids (pdispids, DPS );
Case dispid
102:
Begin
Dostatustextchange (DPS. rgvarg ^ [pdispids ^ [0]. bstrval );
Result: = s_ OK;
End;
108:
Begin
Doprogresschange (DPS. rgvarg ^ [pdispids ^ [0]. lval, DPS. rgvarg ^ [pdispids ^ [1]. lval );
Result: = s_ OK;
End;
105:
Begin
Docommandstatechange (DPS. rgvarg ^ [pdispids ^ [0]. lval, DPS. rgvarg ^ [pdispids ^ [1]. vbool );
Result: = s_ OK;
End;
106:
Begin
Dodownloadbegin ();
Result: = s_ OK;
End;
104:
Begin
Dodownloadcomplete ();
Result: = s_ OK;
End;
113:
Begin
Dotitlechange (DPS. rgvarg ^ [pdispids ^ [0]. bstrval );
Result: = s_ OK;
End;
112:
Begin
Dopropertychange (DPS. rgvarg ^ [pdispids ^ [0]. bstrval );
Result: = s_ OK;
End;
250:
Begin
Dobeforenavigate2 (idispatch (DPS. rgvarg ^ [pdispids ^ [0]. dispval), polevariant (DPS. rgvarg ^ [pdispids ^ [1]. pvarval) ^, polevariant (DPS. rgvarg ^ [pdispids ^ [2]. pvarval) ^, polevariant (DPS. rgvarg ^ [pdispids ^ [3]. pvarval) ^, polevariant (DPS. rgvarg ^ [pdispids ^ [4]. pvarval) ^, polevariant (DPS. rgvarg ^ [pdispids ^ [5]. pvarval) ^, DPS. rgvarg ^ [pdispids ^ [6]. pbool ^ );
Result: = s_ OK;
End;
251:
Begin
Donewwindow2 (idispatch (DPS. rgvarg ^ [pdispids ^ [0]. pdispval ^), DPS. rgvarg ^ [pdispids ^ [1]. pbool ^ );
Result: = s_ OK;
End;
252:
Begin
Donavigatecomplete2 (idispatch (DPS. rgvarg ^ [pdispids ^ [0]. dispval), polevariant (DPS. rgvarg ^ [pdispids ^ [1]. pvarval) ^ );
Result: = s_ OK;
End;
259:
Begin
Dodocumentcomplete (idispatch (DPS. rgvarg ^ [pdispids ^ [0]. dispval), polevariant (DPS. rgvarg ^ [pdispids ^ [1]. pvarval) ^ );
Result: = s_ OK;
End;
253:
Begin
Doonquit ();
Result: = s_ OK;
End;
254:
Begin
Doonvisible (DPS. rgvarg ^ [pdispids ^ [0]. vbool );
Result: = s_ OK;
End;
255:
Begin
Doontoolbar (DPS. rgvarg ^ [pdispids ^ [0]. vbool );
Result: = s_ OK;
End;
256:
Begin
Doonmenubar (DPS. rgvarg ^ [pdispids ^ [0]. vbool );
Result: = s_ OK;
End;
257:
Begin
Doonstatusbar (DPS. rgvarg ^ [pdispids ^ [0]. vbool );
Result: = s_ OK;
End;
258:
Begin
Doonfullscreen (DPS. rgvarg ^ [pdispids ^ [0]. vbool );
Result: = s_ OK;
End;
260:
Begin
Doontheatermode (DPS. rgvarg ^ [pdispids ^ [0]. vbool );
Result: = s_ OK;
End;
End;
Finally
If (bhasparams) Then freemem (pdispids, idispidssize );
End;
End;

Function tiehelper. getidsofnames (const IID: tguid; names: pointer;
Namecount, localeid: integer; DISPIDs: pointer): hresult;
Begin
Result: = e_notimpl;
End;

Function tiehelper. gettypeinfo (index, localeid: integer;
Out typeinfo): hresult;
Begin
Result: = e_notimpl;
Pointer (typeinfo): = nil;
End;

Function tiehelper. gettypeinfocount (Out count: integer): hresult;
Begin
Result: = e_notimpl;
Count: = 0;
End;

Function tiehelper. getsite (const riid: tiid; out site: iunknown): hresult;
Begin
// Result: = s_ OK;
If assigned (IE) then result: = ie. QueryInterface (riid, site)
Else
Result: = e_fail;
End;

Function tiehelper. setsite (const punksite: iunknown): hresult;
VaR
Revoke target: iolecommandtarget;
SP: iserviceprovider;
CPC: iconnectionpointcontainer;
CP: iconnectionpoint;
Begin
If assigned (punksite) then begin
Export target: = punksite as iolecommandtarget;
SP: = target as iserviceprovider;

If assigned (SP) then
Sp. queryservice (iwebbrowserapp, iwebbrowser2, ie );
If assigned (IE) then begin
Ie. QueryInterface (iconnectionpointcontainer, CPC );
CPC. findconnectionpoint (dwebbrowserevents2, CP );
CP. Advise (self, cookie)
End;
End;
Result: = s_ OK;
End;

Procedure tiehelperfactory. addkeys;
VaR S: string;
Begin
S: = guidtostring (class_iehelper );
With Tregistry. Create do
Try
Rootkey: = HKEY_LOCAL_MACHINE;
If openkey ('Software/Microsoft/Windows/CurrentVersion/Explorer/Browser Helper Objects/'+ S, true)
Then closekey;
Finally
Free;
End;
End;

Procedure tiehelperfactory. removekeys;
VaR S: string;
Begin
S: = guidtostring (class_iehelper );
With Tregistry. Create do
Try
Rootkey: = HKEY_LOCAL_MACHINE;
Deletekey ('Software/Microsoft/Windows/CurrentVersion/Explorer/Browser Helper Objects/'+ S );
Finally
Free;
End;
End;

Procedure tiehelperfactory. updateregistry (register: Boolean );
Begin
Inherited updateregistry (Register );
If register then addkeys else removekeys;
End;

Initialization
Tiehelperfactory. Create (comserver, tiehelper, class_iehelper,
'Iehelper', '', cimultiinstance, tmapartment );
End.

The code is long, but the key is the tiehelper. setsite method and tiehelper. Invoke method. Note the following statements in the tiehelper. setsite method:
If assigned (SP) then
Sp. queryservice (iwebbrowserapp, iwebbrowser2, ie );
If assigned (IE) then begin
Ie. QueryInterface (iconnectionpointcontainer, CPC );
CPC. findconnectionpoint (dwebbrowserevents2, CP );
CP. Advise (self, cookie)

The preceding statement first obtains the webbrowser interface of IE and then finds the connection point. The advise method is used to establish the connection between COM itself and the connection point.
After the connection is established successfully, ie calls the invoke method that connects to its own idispatch interface object after an event is triggered. Different events correspond to different dispid codes. We can determine the dispid in the program and handle it accordingly. In the above program, we only process the beforenavigate2 event. The processing function is dobeforenavigate2. In this function, if the site to be browsed is not 'HTTP: // website.
A lot of software, such as the "Flower Ambassador" and "3721" Chinese URLs, use the above principles to respond to IE browser events, such as 3721, when a user enters a Chinese Word and browses it, the COM component can write code in the beforenavigate2 event to access the server and go to the correct site.
The above program in Win2k, Delphi 5 Write Win98, Win2k edit through, if you need the source program or for the COM programming needs to have any advice, welcome to my home page http://www.applevb.com access, I would like to discuss with you.