在自己的程序中使用过WebBrowser控件的朋友都知道,WebBrowser控件定义了诸如BeforeNavigate、DownloadComplete 等事件,我们可以通过编写事件处理代码实现对WebBrowser控件的操作。那么如何实现对IE的事件响应和处理呢?同建立IE面板一样。我们需要建立一个实现IObjectWithSite接口的COM组件,不同的是,我们还需要实现IDispatch接口,在IObjectWithSite接口的SetSite方法中获得IE的WebBrowser接口并建立自身与WebBrowser的连接,然后如果在IE的Webbrowser对象中发生什么事件的话,那么IE就会回调连接的IDispatch接口的Invoke方法。我们通过在Invoke方法中编写代码就可以获得IE事件了。这个利用的是COM编程的回调接口原理。 下面我们首先来实现代码。点击Delphi菜单 File | New 。在 ActiveX 页面中选择Active Library ,然后点击 OK 按钮。然后用同样的方法建立一个COM Object。在COM Object Wizard 窗口中,将复选框 Included type library 去掉。然后在Class Name中输入IEHelper,在Implemented Interface 中输入:IDispatch;IObjectwithSite 。然后点击 OK 按钮建立一个COM组件。 保存工程,将工程保存为IEHelper.dpr,将Unit1保存为IEHelperUnit.pas。下面是IEHelperUnit.pas的具体代码: 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, 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: 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 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('你不可以浏览其它站点'); 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, 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 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; &nbs [1] [2] 下一页 没有相关教程
|