利用Delphi編寫IE擴充套件

Max Woods發表於2014-10-08
套件

就是如何使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;

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
          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，在該函式中，如果瀏覽的站點不是http://www.applevb.com/的話，程式會提示：你不可以瀏覽其它站點並強行轉到http://www.applevb.com。
   很多的軟體，象“護花使者”以及“3721”一類的中文網址”都是利用上面的原理來實現對IE瀏覽器事件響應的，例如3721，當使用者輸入一箇中文詞並瀏覽時，COM元件可以在BeforeNavigate2 事件中編寫程式碼訪問伺服器並轉到正確的站點上去。

 

相關文章