利用Delphi编写IE扩展-白红宇

利用Delphi编写IE扩展

阅读量：4654 次

发布时间：2019-06-09

本文共 10657 字，大约阅读时间需要 35 分钟。

就是如何使IE扩展组件可以响应事件。

在自己的程序中使用过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;interfaceusesWIndows, 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};implementationuses ComServ, Registry, SysUtils;procedure DoStatusTextChange(const Text: WideString);beginend;procedure DoProgressChange(Progress: Integer; ProgressMax: Integer);beginend;procedure DoCommandStateChange(Command: Integer; Enable: WordBool);beginend;procedure DoDownloadBegin;beginend;procedure DoDownloadComplete;beginend;procedure DoTitleChange(const Text: WideString);beginend;procedure DoPropertyChange(const szProperty: WideString);beginend;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);beginend;procedure DoNavigateComplete2(const pDisp: IDispatch; var URL: OleVariant);beginend;procedure DoDocumentComplete(const pDisp: IDispatch; var URL: OleVariant);beginend;procedure DoOnQuit;beginend;procedure DoOnVisible(Visible: WordBool);beginend;procedure DoOnToolBar(ToolBar: WordBool);beginend;procedure DoOnMenuBar(MenuBar: WordBool);beginend;procedure DoOnStatusBar(StatusBar: WordBool);beginend;procedure DoOnFullScreen(FullScreen: WordBool);beginend;procedure DoOnTheaterMode(TheaterMode: WordBool);beginend;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          DoPrtype 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;     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 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(SoftwareMicrosoftWindowsCurrentVersionexplorerBrowser 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(SoftwareMicrosoftWindowsCurrentVersionexplorerBrowser 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.

代码很长，但是关键的是TIEHelper.SetSite方法以及TIEHelper.Invoke方法。在TIEHelper.SetSite方法中注意以下语句：

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)

上面的语句作用是，首先获得IE的Webbrowser接口，然后寻找到连接点。并通过Advise方法建立COM自身与连接点的连接。

当连接建立成功后，IE在有事件引发后，会调用连接到自身的IDispatch接口对象的Invoke方法。不同的事件对应不同的DispID编码，我们可以在程序中判断DispID并做相应的处理。在上面的程序中，我们只处理了BeforeNavigate2 事件，处理函数是DoBeforeNavigate2，在该函数中，如果浏览的站点不是的话，程序会提示：你不可以浏览其它站点并强行转到。

很多的软件，象“护花使者”以及“3721”一类的中文网址”都是利用上面的原理来实现对IE浏览器事件响应的，例如3721，当用户输入一个中文词并浏览时，COM组件可以在BeforeNavigate2 事件中编写代码访问服务器并转到正确的站点上去。

转载于:https://www.cnblogs.com/MaxWoods/p/4012297.html

你可能感兴趣的文章