Oggi, 1° Maggio mi sono svegliato alle 5 del mattino e mi sono alzato 5 minuti dopo dato che il mio organismo mi comunicava in maniera evidente che non aveva più bisogno di sonno. Non avendo progetti specifici per la giornata ho deciso di raccogliere ed ordinare un pò di materiale del tempo che fù inerente i Browser Helper Object

1. Per cominciare

Per far capire di cosa si sta parlando, diciamo che un Browser Helper Object (o più brevemente BHO) è in soldoni una dll che viene mappata automaticamente nello spazio di memoria di Internet Explorer (processo iexplore.exe) e di Windows Explorer (meglio conosciuto come la Shell di Windows, processo explorer.exe). Chi conosce un pò i BHO sa del mapping su Internet Explorer ma spesso non è al corrente del mapping automatico anche su explorer.exe. Dal nostro BHO possiamo poi accedere a svariati eventi (quali ad esempio l'URL di navigazione, il download di un file, etc...). Questo è sufficiente per spiegare nel concreto quale sia l'effetto sul sistema di un BHO. Entrando più nel dettaglio si ha che un BHO è una dll che implementa un oggetto COM: nello specifico, questo oggetto COM deve implementare una interface specifica denominata IObjectWithSite . Questa interface consente di definire una semplice comunicazione tra un oggetto (in questo caso il BHO) ed il suo contenitore (in questo caso iexplore.exe o explorer.exe).

2. Approfondiamo

Vediamo ora di buttarci a capofitto nella creazione di un BHO. La prima cosa da fare è creare la unit Delphi di import della Type Library denominata "Microsoft Browser Helpers" . Si noti che tale Type Library esiste nel caso si abbia installato Internet Explorer 7. In caso negativo (quindi Internet Explorer 6 o inferiori) si dovrà invece cercare la Type Library denominata "Microsoft Internet Controls"; in pratica la Type Library "Microsoft Browser Helpers" fa riferimento alla dll ieframe.dll (nella cartella di sistema) mentre la "Microsoft Internet Controls" fa riferimento all dll shdocvw.dll . In pratica le Com Interface relative ad Internet Explorer sono state reimplementate in ieframe.dll. Tornando alla creazione della unit Delphi di import di questa Type Library, la procedura può essere effettuata facilmente da Delphi (Projects --> Import Type Library) ma preferisco usare un Tool di terze parti tra l'altro OpenSource e scritto in Delphi: si tratta dell' "Event Sink Generator" scaricabile all'indirizzo

http://www.techvanguards.com/products/eventsinkimp/

Come già detto, se si dispone di Internet Explorer 7 va selezionata la Type Library "Microsoft Browser Helpers" (ieframe.dll) mentre in caso contrario si selezionerà la Type Library "Microsoft Internet Controls" (shdocvw.dll). A fine importazione, il risultato sono le 2 unit Delphi denominate SHDocVw_TLB.pas e SHDocVwEvents.pas. Si noti che Delphi già dispone della prima unit sotto il nome shdocvw, tuttavia la creazione manuale della unit ci consente di avere sott'occhio la situazione attuale di Internet Explorer.

3. Procediamo

Nel seguito faremo riferimento alla situazione di Internet Explorer 7. Bene... andiamo al sodo: prima cosa da fare è ottenere le unit di import della Type Library denominata "Microsoft Browser Helpers" (ieframe.dll). Per fare questo ci scarichiamo il "Delphi Event Sink Generator" all'indirizzo

http://www.techvanguards.com/products/eventsinkimp/

Lo lanciamo, selezioniamo nella lista l'elemento "Microsoft Helper Browsers" e click su Import: verranno generate 2 unit .pas di nome SHDocVw_TLB.pas e SHDocVwEvents.pas

Bene, fatto questo, procediamo direttamente alla stesura del codice che implementa un semplice Browser Helper Object

unit uIE_BHO;

interface

uses
  dialogs, sysutils, shdocvw_tlb, registry, Windows, ActiveX, Classes, ComObj;

const

  //per avere i valori qui sotto basta aprire la Unit SHDocVw_TLB.pas creata
  //col "Delphi Event Sink Generator" 
  //(all'indirizzo http://www.techvanguards.com/products/eventsinkimp/) e 
  //cercare la dispinterface denominata DWebBrowserEvents2. I dispid dei metodi 
  //elencati sono i valori che raccogliamo qui sotto

  DISPID_BEFORENAVIGATE = 100; // this is sent before navigation to give a chance to abort
  DISPID_NAVIGATECOMPLETE = 101; // in async, this is sent when we have enough to show
  DISPID_STATUSTEXTCHANGE = 102;
  DISPID_QUIT = 103;
  DISPID_DOWNLOADCOMPLETE = 104;
  DISPID_COMMANDSTATECHANGE = 105;
  DISPID_DOWNLOADBEGIN = 106;
  DISPID_NEWWINDOW = 107; // sent when a new window should be created
  DISPID_PROGRESSCHANGE = 108; // sent when download progress is updated
  DISPID_WINDOWMOVE = 109; // sent when main window has been moved
  DISPID_WINDOWRESIZE = 110; // sent when main window has been sized
  DISPID_WINDOWACTIVATE = 111; // sent when main window has been activated
  DISPID_PROPERTYCHANGE = 112; // sent when the PutProperty method is called
  DISPID_TITLECHANGE = 113; // sent when the document title changes
  DISPID_TITLEICONCHANGE = 114; // sent when the top level window icon may have changed.
  DISPID_FRAMEBEFORENAVIGATE = 200;
  DISPID_FRAMENAVIGATECOMPLETE = 201;
  DISPID_FRAMENEWWINDOW = 204;
  DISPID_BEFORENAVIGATE2 = 250; // hyperlink clicked on
  DISPID_NEWWINDOW2 = 251;
  DISPID_NAVIGATECOMPLETE2 = 252; // UIActivate new document
  DISPID_ONQUIT = 253;
  DISPID_ONVISIBLE = 254; // sent when the window goes visible/hidden
  DISPID_ONTOOLBAR = 255; // sent when the toolbar should be shown/hidden
  DISPID_ONMENUBAR = 256; // sent when the menubar should be shown/hidden
  DISPID_ONSTATUSBAR = 257; // sent when the statusbar should be shown/hidden
  DISPID_ONFULLSCREEN = 258; // sent when kiosk mode should be on/off
  DISPID_DOCUMENTCOMPLETE = 259; // new document goes ReadyState_Complete
  DISPID_ONTHEATERMODE = 260; // sent when theater mode should be on/off
  DISPID_ONADDRESSBAR = 261; // sent when the address bar should be shown/hidden
  DISPID_WINDOWSETRESIZABLE = 262; // sent to set the style of the host window frame
  DISPID_WINDOWCLOSING = 263; // sent before script window.close closes the window
  DISPID_WINDOWSETLEFT = 264; // sent when the put_left method is called on the WebOC
  DISPID_WINDOWSETTOP = 265; // sent when the put_top method is called on the WebOC
  DISPID_WINDOWSETWIDTH = 266; // sent when the put_width method is called on the WebOC
  DISPID_WINDOWSETHEIGHT = 267; // sent when the put_height method is called on the WebOC
  DISPID_CLIENTTOHOSTWINDOW = 268; // sent during window.open to request conversion of dimensions
  DISPID_SETSECURELOCKICON = 269; // sent to suggest the appropriate security icon to show
  DISPID_FILEDOWNLOAD = 270; // Fired to indicate the File Download dialog is opening

  //queste dovrebbero essere le novità di Internet Explorer 7
  DISPID_NAVIGATERROR = 271;
  DISPID_PRINTTEMPLATEINSTANTIATION = 225;
  DISPID_PRINTTEMPLATETEARDOWN = 226;
  DISPID_UPDATEPAGESTATUS = 227;
  DISPID_PRIVACYIMPACTEDSTATECHANGE = 272;
  DISPID_NEWWINDOW3 = 273;
  DISPID_SETPHISHINGFILTERSTATUS = 282;
  DISPID_WINDOWSTATECHANGED = 283;

type

  TShellType = (stInternetExplorer, stUnknown, stWindowsExplorer);

  TIEBHOFactory = class(TComObjectFactory)
  private
    procedure AddKeys;
    procedure RemoveKeys;
  public
    //implementazione del metodo UpdateRegistry di TComObjectFactory
    //
    //"regsvr32 ie_bho.dll" --> viene chiamato UpdateRegistry(True)
    //"regsvr32 ie_bho.dll -u" --> viene chiamato UpdateRegistry(False)
    procedure UpdateRegistry(Register: Boolean); override;
  end;

  TIEBHO = class(TComObject, IDispatch, IObjectWithSite)
  protected
    //implementazione dei metodi della IObjectWithSite interface
    function SetSite(const pUnkSite: IUnknown): HResult; stdcall;
    function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall;
    //

    //implementazione dei metodi della IDispatch interface
    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; virtual; stdcall;
    //

  end;

const
  //premere la combinazione Ctrl+Shift+G per creare un altro GUID
  //questo è il ClassId del nostro BHO: infatti un BHO è essenzialmente un oggetto COM
  //e quindi verrà registrato nel registro di Windows con il suo ClassId come sottochiave
  //della chiave di registro
  //HKLM\Software\Classes\CLSID
  Class_IEBHO: TGUID = '{B1D3576A-CA42-4D09-83C1-15D563C19D71}';
  //un BHO prevede una ulteriore registrazione nel registro di Windows nel ramo HKLM
  BHO_RegKey:string='Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects\';
  //N.B. Se si apre la scheda Opzioni Internet da Internet Explorer
  //("menù principale -> strumenti -> Opzioni Internet" oppure
  //"pulsante destro mouse su icona IE" -> Proprietà"),
  //nel Tab Programmi -> click su "Gestione Componenti Aggiuntivi" viene fuori una lista in cui
  //sono presenti anche i BHO e sotto c'è la possibilità di disattivare il singolo componente
  //selezionato. Da una breve analisi che ho fatto, ho visto che la disattivazione consiste
  //nell'aggiunta di una chiave di registro; nel caso specifico del nostro BHO, esso può essere
  //disattivato con le seguenti modifiche al registro

  //;Disattivazione di un BHO con ClassId pari a "Class_IEBHO"
  //[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Ext\Settings\"Class_IEBHO"]
  //"Flags"=dword:00000001
  //"Version"="*"

  //dove al posto di "Class_IEBHO" ci sarà appunto il suo valore GUID definito sopra; togliendo
  //tale chiave, il BHO ritorna attivo; come si può notare la disattivazione ha effetto
  //a livello dell'utente corrente, nel contesto delle altre utenze il BHO è ancora attivo

var
  IE: IWebbrowser2;

implementation

uses ComServ, uLog;

{ TIEBHO }

const
  //settare a true se si vuole evitare il mapping in explorer.exe
  NoWindowsExplorer = True;
  //settare a true se si vuole evitare il mapping in iexplore.exe
  NoInternetExplorer = False;

var
  Cookie: Integer;
  CP: IConnectionPoint;

//la funzione sotto GetShellType mi dice qual'è l'applicazione nel cui spazio 
//di memoria sta per essere mappato il nostro BHO; 
//per quanto riguarda le finestre di IE e le istanze di iexplore.exe, bisogna 
//dire che tutte le volte che viene creata una nuova finestra di Internet Explorer 
//dal browser ("menù --> File --> Nuova finestra" oppure 
//"right click su un link -> apri in un'altra finestra" oppure
//"left click su un link con il tasto shift premuto" oppure
//"left click su un link che apre in automatico in un'altra finestra") la nuova
//finestra appartiene alla medesima istanza di iexplore.exe della finestra di origine.
//Se invece faccio doppio click sull'icona sul dekstop oppure lancio l'eseguibile
//iexplore.exe, allora la finestra che si apre appartiene ad una nuova istanza
//di iexplore.exe
function GetShellType: TShellType;
var
  ModuleName: array [0..MAX_PATH] of char;
  FileName: string;
begin
  FillChar(ModuleName, MAX_PATH, 0);
  GetModuleFileName(0, pChar(@ModuleName), MAX_PATH);
  FileName := ExtractFileName(pChar(@ModuleName));

  Result := stUnknown;
  if CompareText(FileName, 'iexplore.exe') = 0 then
    Result := stInternetExplorer
  else
    if CompareText(FileName, 'explorer.exe') = 0 then
      Result := stWindowsExplorer;
end;

//di seguito l'elenco delle procedure che verranno chiamate in
//corrispondenza dei singoli eventi possibili: possono essere implementate
//inserendo ad esempio delle righe di codice per loggare l'evento (ad esempio
//trascriverlo su un file); la funzione LogData che ho implementato nella unit
//uLog.pas ad esempio aggiunge una riga nel memo della form THelperForm

procedure DoStatusTextChange(const Text: WideString);
begin
  //LogData('Statustext: ' + TEXT);
end;

procedure DoProgressChange(
                          Progress: Integer;
                          ProgressMax: Integer
                          );
begin
  //LogData('ProgressChange: ' + InttoStr(Progress) + '/' + InttoStr(ProgressMax));
end;

procedure DoCommandStateChange(
                              Command: Integer;
                              Enable: WordBool
                              );
begin
  //LogData('CommandStateChange: COMMAND:' + InttoStr(Command));
end;

procedure DoDownloadBegin;
begin
  //LogData('Download Begin');
end;

procedure DoDownloadComplete;
begin
  //LogData('Download Complete');
end;

procedure DoTitleChange(const Text: WideString);
begin
  //LogData('TitleChange: ' + TEXT);
end;

procedure DoPropertyChange(const szProperty: WideString);
begin
  //LogData('PropertyChange: ' + szProperty);
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
  LogData('Indirizzo: ' + URL);
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 DoWindowSetResizable(Resizable: WordBool);
begin

end;

procedure DoWindowSetLeft(Left: Integer);
begin

end;

procedure DoWindowSetTop(Top: Integer);
begin

end;

procedure DoWindowSetWidth(Width: Integer);
begin

end;

procedure DoWindowSetHeight(Height: Integer);
begin

end;

procedure DoWindowClosing(
                         IsChildWindow: WordBool;
                         var Cancel: WordBool
                         );
begin

end;

procedure DoClientToHostWindow(
                              var CX: Integer;
                              var CY: Integer
                              );
begin

end;

procedure DoSetSecureLockIcon(SecureLockIcon: Integer);
begin

end;

procedure DoFileDownload(var Cancel: WordBool);
begin

end;

procedure DoNavigateError(
                         const pDisp: IDispatch;
                         var URL: OleVariant;
                         var Frame: OleVariant;
                         var StatusCode: OleVariant;
                         var Cancel: WordBool
                         );
begin

end;

procedure DoPrintTemplateInstantiation(const pDisp: IDispatch);
begin

end;

procedure DoPrintTemplateTeardown(const pDisp: IDispatch);
begin

end;

procedure DoUpdatePageStatus(
                            const pDisp: IDispatch;
                            var nPage: OleVariant;
                            var fDone: OleVariant
                            );
begin

end;

procedure DoPrivacyImpactedStateChange(bImpacted: WordBool);
begin

end;

procedure DoNewWindow3(
                      var ppDisp: IDispatch;
                      var Cancel: WordBool;
                      dwFlags: LongWord;
                      const bstrUrlContext: WideString;
                      const bstrUrl: WideString
                      );
begin

end;

procedure DoSetPhishingFilterStatus(PhishingFilterStatus: Integer);
begin

end;

procedure DoWindowStateChanged(
                              dwWindowStateFlags: LongWord;
                              dwValidFlagsMask: LongWord
                              );
begin

end;



//procedura presa dalla unit SHDocVwEvents
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;

//l'implementazione qui sotto è ottenuta prendendo
//l'implementazione di TSHDocVwEventsBaseSink.Invoke
//nella unit SHDocVwEvents; al posto della riga
//Result := DoInvoke (DispId, IID, LocaleID ...)
//andiamo a mettere l'implementazione di TSHDocVwDWebBrowserEvents2.DoInvoke
function TIEBHO.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
  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);
    Result := S_OK;
    case DispId of
      DISPID_STATUSTEXTCHANGE: //102
        DoStatusTextChange(dps.rgvarg^[pDispIds^[0]].bstrval);
      DISPID_PROGRESSCHANGE: //108
        DoProgressChange(
                        dps.rgvarg^[pDispIds^[0]].lval,
                        dps.rgvarg^[pDispIds^[1]].lval
                        );
      DISPID_COMMANDSTATECHANGE: //105
        DoCommandStateChange(
                            dps.rgvarg^[pDispIds^[0]].lval,
                            dps.rgvarg^[pDispIds^[1]].vbool
                            );
      DISPID_DOWNLOADBEGIN: //106
        DoDownloadBegin();
      DISPID_DOWNLOADCOMPLETE: //104
        DoDownloadComplete();
      DISPID_TITLECHANGE: //113
        DoTitleChange(dps.rgvarg^[pDispIds^[0]].bstrval);
      DISPID_PROPERTYCHANGE: //112
        DoPropertyChange(dps.rgvarg^[pDispIds^[0]].bstrval);
      DISPID_BEFORENAVIGATE2: //250
        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^
                         );
      DISPID_NEWWINDOW2: //107
        DoNewWindow2(
                    IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
                    dps.rgvarg^[pDispIds^[1]].pbool^
                    );
      DISPID_NAVIGATECOMPLETE2: //101
        DoNavigateComplete2(
                           IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
                           POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^
                           );
      DISPID_DOCUMENTCOMPLETE: //259
        DoDocumentComplete(
                          IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
                          POleVariant(dps.rgvarg^[pDispIds^[1]].pvarval)^
                          );
      DISPID_ONVISIBLE: //254
        DoOnVisible(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_ONTOOLBAR: //255
        DoOnToolBar(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_ONMENUBAR: //256
        DoOnMenuBar(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_ONSTATUSBAR: //257
        DoOnStatusBar(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_ONFULLSCREEN: //258
        DoOnFullScreen(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_ONTHEATERMODE: //260
        DoOnTheaterMode(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_WINDOWSETRESIZABLE: //262
        DoWindowSetResizable(dps.rgvarg^[pDispIds^[0]].vbool);
      DISPID_WINDOWCLOSING: //263
        DoWindowClosing(
                       dps.rgvarg^[pDispIds^[0]].vbool,
                       dps.rgvarg^[pDispIds^[1]].pbool^
                       );
      DISPID_WINDOWSETLEFT: //264
        DoWindowSetLeft(dps.rgvarg^[pDispIds^[0]].lval);
      DISPID_WINDOWSETTOP: //265
        DoWindowSetTop(dps.rgvarg^[pDispIds^[0]].lval);
      DISPID_WINDOWSETWIDTH: //266
        DoWindowSetWidth(dps.rgvarg^[pDispIds^[0]].lval);
      DISPID_WINDOWSETHEIGHT: //267
        DoWindowSetHeight(dps.rgvarg^[pDispIds^[0]].lval);
      DISPID_CLIENTTOHOSTWINDOW: //268
        DoClientToHostWindow(
                            dps.rgvarg^[pDispIds^[0]].plval^,
                            dps.rgvarg^[pDispIds^[1]].plval^
                            );
      DISPID_SETSECURELOCKICON: //269
        DoSetSecureLockIcon(dps.rgvarg^[pDispIds^[0]].lval);
      DISPID_FILEDOWNLOAD: //270
        DoFileDownload(dps.rgvarg^[pDispIds^[0]].pbool^);
      DISPID_NAVIGATERROR: //271
        DoNavigateError(
                       IDispatch(dps.rgvarg^[pDispIds^[0]].dispval),
                       POleVariant(dps.rgvarg^[pDispIds^ [1]].pvarval)^,
                       POleVariant(dps.rgvarg^[pDispIds^ [2]].pvarval)^,
                       POleVariant(dps.rgvarg^[pDispIds^ [3]].pvarval)^,
                       dps.rgvarg^[pDispIds^[4]].pbool^
                       );
      DISPID_PRINTTEMPLATEINSTANTIATION: //225
        DoPrintTemplateInstantiation(IDispatch(dps.rgvarg^ [pDispIds^ [0]].dispval));
      DISPID_PRINTTEMPLATETEARDOWN: //226
        DoPrintTemplateTeardown(IDispatch(dps.rgvarg^ [pDispIds^ [0]].dispval));
      DISPID_UPDATEPAGESTATUS: //227
        DoUpdatePageStatus(
                          IDispatch(dps.rgvarg^[pDispIds^ [0]].dispval),
                          POleVariant(dps.rgvarg^ [pDispIds^ [1]].pvarval)^,
                          POleVariant(dps.rgvarg^ [pDispIds^ [2]].pvarval)^
                          );
      DISPID_PRIVACYIMPACTEDSTATECHANGE:  //272
        DoPrivacyImpactedStateChange(dps.rgvarg^ [pDispIds^ [0]].vbool);
      DISPID_NEWWINDOW3: //273
        DoNewWindow3(
                    IDispatch(dps.rgvarg^[pDispIds^[0]].pdispval^),
                    dps.rgvarg^[pDispIds^[1]].pbool^,
                    LongWord(dps.rgvarg^[pDispIds^[2]].lval),
                    dps.rgvarg^[pDispIds^[3]].bstrval,
                    dps.rgvarg^[pDispIds^[4]].bstrval
                    );
      DISPID_SETPHISHINGFILTERSTATUS: //282
        DoSetPhishingFilterStatus(dps.rgvarg^[pDispIds^[0]].lval);
      DISPID_WINDOWSTATECHANGED: //283
        DoWindowStateChanged(
                            LongWord(dps.rgvarg^[pDispIds^[0]].lval),
                            LongWord(dps.rgvarg^[pDispIds^[1]].lval)
                            );
      DISPID_ONQUIT: //103
        begin
          DoOnQuit();
          CP.Unadvise(Cookie);
        end;
    else
      Result := DISP_E_MEMBERNOTFOUND;
    end;
  finally
    if (bHasParams) then
      FreeMem(pDispIds, iDispIdsSize);
  end;
end;


function TIEBHO.SetSite(const pUnkSite: IUnknown): HResult;
var
  CPC: IConnectionPointContainer;
  ShellType: TShellType;
begin
  ShellType := GetShellType;
  if ((ShellType = stWindowsExplorer) and (not NoWindowsExplorer)) or
     ((ShellType = stInternetExplorer) and (not NoInternetExplorer)) then
    begin
      if Assigned(pUnkSite) then
        begin
          IE := pUnkSite as IWebbrowser2;
          CPC := IE as IConnectionPointContainer;
          CPC.FindConnectionPoint(DWebBrowserEvents2, CP);
          CP.Advise(Self, Cookie);
          //creazione della form che riceverà il Log
          CreateHelperForm;
          //
        end;
    end;
  Result := S_OK
end;


function TIEBHO.GetSite(
                       const riid: TIID;
                       out site: IUnknown
                       ): HResult;
begin
  Result := S_OK;
end;


procedure TIEBHOFactory.AddKeys;
var S: string;
begin
  S := GUIDToString(Class_IEBHO);
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    if OpenKey(BHO_RegKey + S, TRUE)
      then CloseKey;
  finally
    free;
  end;
end;


procedure TIEBHOFactory.RemoveKeys;
var S: string;
begin
  S := GUIDToString(Class_IEBHO);
  with TRegistry.Create do
  try
    RootKey := HKEY_LOCAL_MACHINE;
    DeleteKey(BHO_RegKey + S);
  finally
    free;
  end;
end;

procedure TIEBHOFactory.UpdateRegistry(Register: Boolean);
begin
  inherited UpdateRegistry(Register);
  if Register then
    //UpdateRegistry(True) in corrispondenza di "regsvr32 ie_bho.dll"
    AddKeys //registra ie_bho.dll come un Browser Helper Object
  else
    //UpdateRegistry(False) in corrispondenza di "regsvr32 ie_bho.dll -u"
    RemoveKeys; //elimina ie_bho.dll dall'elenco dei Browser Helper Object
end;


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


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

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



initialization

  TIEBHOFactory.Create(
                      ComServer,
                      TIEBHO,
                      Class_IEBHO,
                      '',
                      '',
                      ciMultiInstance,
                      tmApartment
                      );
end.

In allegato l'esempio completo di tutti i file

BHO.7z