uiemonitor.~pas

使用BHO的一个例子

unit UIEMonitor;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, SHDOCVW, Dialogs, SysUtils, Registry;



type
  TIEMonitor = 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 SetSite(const pUnkSite:IUnknown):HResult;stdcall;
    function GetSite(const riid:TIID;out site:IUnknown):HResult;stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  private
    IEThis:IWebBrowser2;
    Cookie:Integer;
  protected
  end;

const
  Class_IEMonitor: TGUID = '{47CFDDF9-6FBD-4C06-8752-24FEFBA10D51}';
  
var
  reg:Tregistry;
implementation

uses ComServ, Sysutils, ComConst;

procedure DoBeforeNavigate2(const pDisp:IDispatch;var URL:OleVariant;
  var Flags:OleVariant;var TargetFrameName:OleVariant;var PostData:OleVariant;
  var Headers:OleVariant;var Cancel:WordBool);
var
  i:Integer;
begin
 //       Reg:=TRegistry.Create;
 //       Reg.RootKey:=HKEY_CURRENT_USER;
 //       Reg.OpenKey('Software\Microsoft\Internet Explorer\Main\', True);
 //       Reg.WriteString('Start Page','about:blank');
 //        Reg.CloseKey;
 //       Reg.Free;
    if (URL='')  or (URL='about:blank')  then
      begin
        Cancel:=True;
        URL:='http://www.auto168.net';
        (pDisp as  IWebbrowser2).Navigate2(URL,Flags,TargetFrameName,PostData,Headers);
      end;
end;
procedure DoOnQuit;
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 TIEMonitor.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
      104:begin
          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; 
      253:begin
          DoOnQuit();
          Result:=S_OK;
        end;
    end;//end of case DispID of
  finally
    if(bHasParams)then
      FreeMem(pDispIDs,iDispIDsSize);
  end;
end;

function TIEMonitor.GetTypeInfo(Index,LocaleID:Integer;out TypeInfo):HResult;
begin
  Result:=E_NOTIMPL;
  Pointer(TypeInfo):=nil;
end;

function TIEMonitor.GetTypeInfoCount(out Count:Integer):HResult;
begin
  Result:=E_NOTIMPL;
  Count:=0;
end;

function TIEMonitor.GetIDsOfNames(const IID:TGUID;Names:Pointer;
  NameCount,LocaleID:Integer;DispIDs:Pointer):HResult;
begin
  Result:=E_NOTIMPL;
end;

function TIEMonitor.GetSite(const riid:TIID;out site:IUnknown):HResult;
begin
  //ShowMessage('执行了GetSite事件！');
  if(Assigned(IEThis))then
    Result:=IEThis.QueryInterface(riid,site)
  else Result:=E_FAIL;
end;

function TIEMonitor.SetSite(const pUnkSite:IUnknown):HResult;
var
  cmdTarget:IOleCommandTarget;
  Sp:IServiceProvider;
  CPC:IConnectionPointContainer;
  CP:IConnectionPoint;
begin
  //ShowMessage('执行了SetSite事件！');
  if(Assigned(pUnkSite))then
  begin
    cmdTarget:=(pUnkSite as IOleCommandTarget);
    Sp:=(CmdTarget as IServiceProvider);
    if(Assigned(Sp))then//获得IE的WebBrowser接口，
      Sp.QueryService(IWebBrowserApp,IWebBrowser2,IEThis);
    if(Assigned(IEThis))then
    begin
      IEThis.QueryInterface(IConnectionPointContainer,CPC);//寻找连接点
      CPC.FindConnectionPoint(DWEBBrowserEvents2,CP);
      CP.Advise(Self,Cookie);//通过Advise方法建立Com自身与连接点的连接
    end;
  end;
  Result:=S_OK;
end;

  procedure DeleteRegKeyValue(Root: DWORD; Key: string; ValueName: string = '');
var
  KeyHandle: HKEY;
begin
  if ValueName = '' then
    RegDeleteKey(Root, PChar(Key));
  if RegOpenKey(Root, PChar(Key), KeyHandle) = ERROR_SUCCESS then
  try
    RegDeleteValue(KeyHandle, PChar(ValueName));
  finally
    RegCloseKey(KeyHandle);
  end;
end;

procedure CreateRegKeyValue(Root: DWORD; const Key, ValueName, Value: string);
var
  Handle: HKey;
  Status, Disposition: Integer;
begin
  Status := RegCreateKeyEx(ROOT, PChar(Key), 0, '',
    REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle,
    @Disposition);
  if Status = 0 then
  begin
    Status := RegSetValueEx(Handle, PChar(ValueName), 0, REG_SZ,
      PChar(Value), Length(Value) + 1);
    RegCloseKey(Handle);
  end;
  if Status <> 0 then
    raise EOleRegistrationError.CreateRes(@SCreateRegKeyError);
end;

type
  TIEAdvBHOFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

{ TIEAdvBHOFactory }

procedure TIEAdvBHOFactory.UpdateRegistry(Register: Boolean);
begin
  inherited;
  if Register then
    CreateRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + GuidToString(ClassID), '', '')
  else
    DeleteRegKeyValue(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\' + GuidToString(ClassID), '');
end;

initialization
  TIEAdvBHOFactory.Create(ComServer, TIEMonitor, Class_IEMonitor,
    'IEMonitor', '', ciMultiInstance, tmApartment);

end.