利用Delphi编写IE扩展(1)

页面导航:首页 > 软件编程 > Delphi > 利用Delphi编写IE扩展(1)

利用Delphi编写IE扩展(1)

来源: 作者: 时间:2016-02-05 11:47 【

在自己的程序中使用过WebBrowser控件的朋友都知道,WebBrowser控件定义了诸如BeforeNavigate、DownloadComplete 等事件,我们可以通过编写事件处理代码实现对WebBrowser控件的操作。那么如

 


   在自己的程序中使用过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;

 

Tags:

相关文章

    文章评论

    最 近 更 新
    热 点 排 行
    Js与CSS工具
    代码转换工具
    
    <