ITPub博客

首页 > 应用开发 > IT综合 > 利用Delphi编写IE扩展 (转)

利用Delphi编写IE扩展 (转)

原创 IT综合 作者:amyz 时间:2007-10-02 10:48:59 0 删除 编辑
利用Delphi编写IE扩展 (转)[@more@]

就是如何使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
  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 事件中编写代码访问服务器并转到正确的站点上去。
  以上程序在Win2k、Delphi 5下编写 win98、Win2K下编辑通过,如果大家需要源程序或者对于COM编程需要有什么的指教的话,欢迎到我的主页 http://www.applevb.com 访问,我愿意同大家一起探讨。


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10752019/viewspace-974389/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    3984
  • 访问量
    7338888