Just how to make the IE extension component can respond to events. Friends who have used WebBrowser controls in their own programs know that the webbrowser control defines events such as Beforenavigate, DownloadComplete, and we can implement the operation of the WebBrowser control by writing event processing code. So how do you achieve the event response and processing of IE? Like the establishment of the IE panel. We need to build a COM component that implements the IObjectWithSite interface. Different, we also need to implement the IDispatch interface, get the WebBrowser interface of IE in the IObjectWithSite interface and build itself with WebBrowser connections, then in the IE webbrowser object If something happens, then IE will call the INVOKE method of the connected iDispatch interface. We get IE events by writing code in the Invoke method. This utilization is the principle of COM programming callback interface. Below we first implemented code. Click Delphi Menu File | New. Select Active Library in the ActiveX page, then click the OK button. Then create a COM Object with the same method. In the COM Object Wizard window, remove the check box inCluded Type Library. Then enter iehelper in the class name, enter: iDispatch; iObjectWithsite. Then click the OK button to create a COM component. Save the project, save the project as IEHELPER.DPR, save Unit1 as IEHELPERUNIT.PAS. Here is the specific code of IEHELPERUNIT.PAS:
Unit iehelperunit;
Interface
Useswindows, Comobj, ActiveX, Shdocvw, MSHTML, DIALOGO;
Type
TiehelperFactory = Class (TcombjectFactory) 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, ExcepInfo, 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-45913F368388}';
IMPLEMENTATION
Uses Comserv, Registry, sysutils;
Procedure DostatustextChange (const text: wideString); Begin
END;
Procedure DoprogressChange (Progress); projectmax: 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 DoBeforeNavigate2 (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 don't browse other sites'); Cancel: = true; URL: = 'http://www.applevb.com'; (PDISP As IWebBrowser2) .naviGate2 (URL, Flags, TargetFramename, PostData, Headers; end;
Procedure Donewindow2 (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; 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;
function TIEHelper.Invoke (DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, 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 of 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 Donewindow2 (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 (); Resul T: = 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;
Function Tie Helper.gettypeInfo (INDEX, LOCALEID: INTEGER; OUT TYPEINFO): HRESULT; Begin Result: = E_NOTIMPL; POINTER (TypeInfo): = nil; end;
Function TIEHEHELPER.GETTYPEINFOCOUNT (OUT Count: Integer): hResult; begin result: = E_NOTIMPL; count: = 0;
Function TIEHEHELPER.GETSITE (Const Rid: Tiid; Out Site: IUnknown): HRESULT; Begin // Result: = S_OK; IE.QUERYINTERFACE (RIID, Site) Else Result: = E_FAIL; END ;
function TIEHelper.SetSite (const pUnkSite: IUnknown): HResult; var cmdTarget: IOleCommandTarget; Sp: IServiceProvider; CPC: IConnectionPointContainer; CP: ICOnnectionPoint; begin if Assigned (pUnkSite) then begin cmdTarget: = pUnkSite as IOleCommandTarget; Sp: = CmdTarget 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).
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 dam e;
Initialization TiehelperFactory.create (COMSERVER, TIEHEHELPER, Class_iehelper, 'IEhelper', ', CIMULTIINSTANCE, TMAPARTMENT); END.
The code is very long, but the key is the Tiehelper.setSite method and the Tiehelper.invoke method. Note that the following statement TIEHelper.SetSite process: 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 above statement is to get the WebBrowser interface of the IE, then look for the connection point. And establish a connection between COM itself and the connection point via the Advise method. When the connection is successfully established, IE will call the INVOKE method to connect to its own IDispatch interface object after the event is initiated. Different events correspond to different DISPID encodings, we can determine DISPID in the program and do appropriate processing. In the above program, we only deal with the beforenaviGate2 event, the process function is DOBEFORENAVIGATE2, in this function, if the viewed site is not 'http://www.applevb.com/', the program will prompt: 'You can't Browse Other Site 'and forced to http://www.applevb.com. A lot of software, the Chinese website like "Flowering Messers" and "3721" "" 3721 "" "3721" is used to realize the response to the IE browser event, such as 3721, when the user enters a Chinese word and browsing, COM Components can write code access servers in the BeforenaviGate2 event and go to the correct site. The above program is written in Win2K, Delphi 5, and the editing of Win2k is passed. If you need the source or what is needed for COM programming, Welcome to my homepage http://www.applevb.com, I am willing to discuss with everyone.
