Announcement

Collapse
No announcement yet.

Create a BHO with pb

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Create a BHO with pb

    Hi all,

    i´m using a custom download manager for years now.
    Until now i integrated it into ie modifying ie´s
    contextmenu. Clicking "my downlod" here fires a script
    that passes the url of the file to download and the
    url of the current site to my download manger. Works
    very well alltogether.

    Since pb offers writing com dll now, i wanted to invoke my
    download manger by a left click with the mouse instead of
    right click (-> contextmenu), left click (-> my download).

    There are two ways to do it (as far as i know until now).

    1.) writing a BHO (Browser Helper Object) for ie
    2.) writing a custom download manger intergating into ie

    below is some c code i put together from snippets i found on the web
    it compiles and after registering it works as expected !

    From that i tried to port it to pb for a start i use the code below
    it copiles, can be registerd, the dll loads into ie
    (msgbox "BHO works !" appears when starting ie) but
    dosent integrate into ie (no msgbox "SetSite").

    As fas i understand, my bho must expose a "IObjectWithSite"
    interface with two methods: "SetSite" and "GetSite".
    SetSite method should be called by ie upon loading a new site.
    Nothing happens.

    All registry settings seem to be correct, otherwise "BHO works !"
    shouldn´t appear. The dll stays loaded into ie, while it is running
    ("BHO end" appears if ie is closed). i embedded the typelib into my
    dll, pb com browser shows my class as expected.

    Oleview shows IObjectWithSite interface is marked as noncreatable ???
    Letters are all uppercase (IOBJECTWITHSITE) does this matter,
    because c is case sensitive, is com case sensitive too ?

    So what am i doing wrong here ? Help appreciated.



    c code sample:

    Code:
    #include <windows.h>
    #include <tchar.h>
    #include <exdisp.h>
    #include <exdispid.h>
    #include <mshtml.h>
    #include <mshtmdid.h>
    #include <shlwapi.h>
    
    HINSTANCE hInstance;
    LONG gref=0;
    const CLSID BhoCLSID = {0xC9C42510,0x9B41,0x42c1,0x9D,0xCD,0x72,0x82,0xA2,0xD0,0x7C,0x61};
    #define BhoCLSIDs  _T("{C9C42510-9B41-42c1-9DCD-7282A2D07C61}")
    
    
    
    class BHO : public IObjectWithSite, public IDispatch 
    { long ref;
      IWebBrowser2* webBrowser;
      IHTMLDocument* doc; IHTMLDocument2 *doc2;
      IHTMLWindow2 *win2;
    public:
      // IUnknown...
      HRESULT STDMETHODCALLTYPE QueryInterface(REFIID riid, void **ppv) {
        if (riid==IID_IUnknown) *ppv=static_cast<BHO*>(this); 
        else if (riid==IID_IObjectWithSite) *ppv=static_cast<IObjectWithSite*>(this); 
        else if (riid==IID_IDispatch) *ppv=static_cast<IDispatch*>(this); 
        else return E_NOINTERFACE; AddRef(); 
        return S_OK;} 
      
      ULONG STDMETHODCALLTYPE AddRef() {
        InterlockedIncrement(&gref); 
        return InterlockedIncrement(&ref);}
      
      ULONG STDMETHODCALLTYPE Release() {
        int tmp=InterlockedDecrement(&ref); 
        if (tmp==0) delete this; 
        InterlockedDecrement(&gref); 
        return tmp;}
    
      // IDispatch...
      HRESULT STDMETHODCALLTYPE GetTypeInfoCount(unsigned int FAR* pctinfo) {
        *pctinfo=1; 
        return NOERROR;}
      
      HRESULT STDMETHODCALLTYPE GetTypeInfo(unsigned int iTInfo, LCID lcid, ITypeInfo FAR* FAR*  ppTInfo) {
        return NOERROR;}
    
      HRESULT STDMETHODCALLTYPE GetIDsOfNames(REFIID riid, OLECHAR FAR* FAR* rgszNames, unsigned int cNames, LCID lcid, DISPID FAR* rgDispId) {
        return NOERROR;}
    
    
    
      HRESULT STDMETHODCALLTYPE Invoke(DISPID dispIdMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS FAR* pDispParams, VARIANT FAR* pVarResult, EXCEPINFO FAR* pExcepInfo, unsigned int FAR* puArgErr)
      { 
        // DISPID_DOCUMENTCOMPLETE: This is the earliest point we can obtain the "document" interface
        if (dispIdMember==DISPID_DOCUMENTCOMPLETE)
        { if (!webBrowser) return E_FAIL; 
          IDispatch *idisp; webBrowser->get_Document(&idisp);
          if (idisp && !doc) idisp->QueryInterface(IID_IHTMLDocument, (void**)&doc);
          if (idisp && !doc2) idisp->QueryInterface(IID_IHTMLDocument2, (void**)&doc2);
          if (doc2 && !win2) doc2->get_parentWindow(&win2);
          IConnectionPointContainer *cpc=0; 
          if (doc) doc->QueryInterface(IID_IConnectionPointContainer, (void**) &cpc);
          IConnectionPoint* cp=0; 
          if (cpc) cpc->FindConnectionPoint(DIID_HTMLDocumentEvents2, &cp);
          DWORD cookie; 
          HRESULT hr; 
          if (cp) hr=cp->Advise(static_cast<IDispatch*>(this), &cookie);
          if (cp) cp->Release(); 
          if (cpc) cpc->Release(); 
          if (idisp) idisp->Release();
          if (!doc || !doc2 || !win2 || hr!=S_OK) {release(); 
          return E_FAIL;}
          return NOERROR;
        }
    
        if (dispIdMember==DISPID_HTMLDOCUMENTEVENTS_ONCLICK)
        { // This shows how to respond to simple events.
          MessageBox(0,_T("Try pressing some keys on the keyboard!"),_T("BHO"),MB_OK); 
          return NOERROR;
        }
    
        if (dispIdMember==DISPID_HTMLDOCUMENTEVENTS_ONKEYDOWN)
        { // This shows how to examine the "event object" of an event
          IDispatch *param1=0; 
          if (pDispParams->cArgs==1 && (pDispParams->rgvarg)[0].vt==VT_DISPATCH) param1=(pDispParams->rgvarg)[0].pdispVal;
          IHTMLEventObj *pEvtObj=0; 
          if (param1) param1->QueryInterface(IID_IHTMLEventObj, (void**)&pEvtObj);
          long keycode; 
          HRESULT hr; 
          if (pEvtObj) hr=pEvtObj->get_keyCode(&keycode);
          if (pEvtObj) pEvtObj->Release();
          if (!pEvtObj || hr!=S_OK) return E_FAIL;
          // This shows how to manipulate the CSS style of an element
          int i=keycode-32; 
          if (i<0) i=0; if (i>63) i=63; i*=4;
          wchar_t buf[100]; 
          wsprintfW(buf,L"rgb(%i,%i,%i)",i,255-i,i/2);
          IHTMLElement *body=0; doc2->get_body(&body);
          IHTMLStyle *style=0; if (body) body->get_style(&style);
          VARIANT v; v.vt=VT_BSTR; v.bstrVal=buf;
          if (style) style->put_backgroundColor(v);
          if (style) style->Release(); 
          if (body) body->Release();
          if (!body || !style) return E_FAIL;
          return NOERROR;
        }
        return NOERROR;
      }
    
      // IObjectWithSite...
      HRESULT STDMETHODCALLTYPE GetSite(REFIID riid, void** ppvSite) {
        return E_NOINTERFACE;}
      
      HRESULT STDMETHODCALLTYPE SetSite(IUnknown* iunk)
      { // This is called by IE to plug us into the current web window
        release();
        iunk->QueryInterface(IID_IWebBrowser2, (void**)&webBrowser);
        IConnectionPointContainer *cpc=0; 
        iunk->QueryInterface(IID_IConnectionPointContainer, (void**)&cpc);
        IConnectionPoint* cp=0; if (cpc) cpc->FindConnectionPoint(DIID_DWebBrowserEvents2, &cp);
        DWORD cookie; 
        HRESULT hr; 
        if (cp) hr=cp->Advise(static_cast<IDispatch*>(this), &cookie);
        if (!webBrowser || !cpc || !cp || hr!=S_OK) {if (cp) cp->Release(); 
        if (cpc) cpc->Release(); 
        release(); 
        return E_FAIL;}
        return S_OK;
      }
    
      // BHO...
      BHO() : ref(0), webBrowser(0), doc(0), doc2(0), win2(0) {};
      ~BHO() {release();}
      void release() {
        if (webBrowser) webBrowser->Release(); 
        webBrowser=0; if (doc) doc->Release(); 
        doc=0; 
        if (doc2) doc2->Release(); 
        doc2=0; 
        if (win2) win2->Release(); 
        win2=0;}
    
    };
    
    
    
    
    
    
    
    class MyClassFactory : public IClassFactory
    { long ref;
      public:
      // IUnknown... (nb. this class is instantiated statically, which is why Release() doesn't delete it.)
      HRESULT STDMETHODCALLTYPE QueryInterface(REFIID riid, void **ppv) {
        if (riid==IID_IUnknown || riid==IID_IClassFactory) {*ppv=this; 
        AddRef(); 
        return S_OK;} 
        else return E_NOINTERFACE;}
    
      ULONG STDMETHODCALLTYPE AddRef() {
        InterlockedIncrement(&gref); 
        return InterlockedIncrement(&ref);}
    
      ULONG STDMETHODCALLTYPE Release() {
        int tmp = InterlockedDecrement(&ref); 
        InterlockedDecrement(&gref); return tmp;}
      // IClassFactory...
    
      HRESULT STDMETHODCALLTYPE LockServer(BOOL b) {
        if (b) InterlockedIncrement(&gref); 
        else InterlockedDecrement(&gref); 
        return S_OK;}
    
      HRESULT STDMETHODCALLTYPE CreateInstance(LPUNKNOWN pUnkOuter, REFIID riid, LPVOID *ppvObj) {
        *ppvObj = NULL; 
        if (pUnkOuter) return CLASS_E_NOAGGREGATION; 
        BHO *bho=new BHO(); 
        bho->AddRef(); 
        HRESULT hr=bho->QueryInterface(riid, ppvObj); 
        bho->Release(); 
        return hr;}
    
      // MyClassFactory...
    
      MyClassFactory() : ref(0) {}
    };
    
    
    STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID *ppvOut)
    { static MyClassFactory factory; *ppvOut = NULL;
      if (rclsid==BhoCLSID) {return factory.QueryInterface(riid,ppvOut);}
      else return CLASS_E_CLASSNOTAVAILABLE;
    }
    
    STDAPI DllCanUnloadNow(void)
    { return (gref>0)?S_FALSE:S_OK;
    }
    
    STDAPI DllRegisterServer(void)
    { TCHAR fn[MAX_PATH]; GetModuleFileName(hInstance,fn,MAX_PATH);
      SHSetValue(HKEY_CLASSES_ROOT,_T("CLSID\\")BhoCLSIDs,_T(""),REG_SZ,_T("BHO"),4*sizeof(TCHAR));
      SHSetValue(HKEY_CLASSES_ROOT,_T("CLSID\\")BhoCLSIDs _T("\\InProcServer32"),_T(""),REG_SZ,fn,((int)_tcslen(fn)+1)*sizeof(TCHAR));
      SHSetValue(HKEY_CLASSES_ROOT,_T("CLSID\\")BhoCLSIDs _T("\\InProcServer32"),_T("ThreadingModel"),REG_SZ,_T("Apartment"),10*sizeof(TCHAR));
      SHSetValue(HKEY_LOCAL_MACHINE,_T("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Browser Helper Objects\\")BhoCLSIDs,_T(""),REG_SZ,_T(""),sizeof(TCHAR));
      return S_OK;
    }
    
    STDAPI DllUnregisterServer()
    { SHDeleteKey(HKEY_CLASSES_ROOT,_T("CLSID\\") BhoCLSIDs);
      SHDeleteKey(HKEY_LOCAL_MACHINE,_T("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Browser Helper Objects\\")BhoCLSIDs);
      return S_OK;
    }
    
    BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved)
    { if (fdwReason==DLL_PROCESS_ATTACH) hInstance=hinstDLL;
    
    
    TCHAR szFilename[MAX_PATH];
            GetModuleFileName(NULL, szFilename, MAX_PATH);
            _tcslwr(szFilename);
    
            if (_tcsstr(szFilename, _T("explorer.exe")) != NULL) return FALSE;
    
            // For performance reasons, we don't want to be called on thread events
        DisableThreadLibraryCalls(hinstDLL);
    
      return TRUE;
    }
    #################################################

    pb code:


    Code:
    #COMPILE DLL "BHO.dll"
    #DIM ALL
    #COM DOC  "BHO Testversion"
    #COM NAME "BHO_dll", 1.0
    #COM GUID GUID$("{8C5D6B75-6CC0-4116-A720-55E17E190C78}")
    #COM TLIB ON
    
    #RESOURCE "BHO.pbr"
    
    
    %USEMACROS = 1
    #INCLUDE "Win32API.inc"
    
    
    '***********************************************************************************************
    '***********************************************************************************************
    
    
    FUNCTION LIBMAIN (BYVAL hInstance   AS LONG, _
                      BYVAL fwdReason   AS LONG, _
                      BYVAL lpvReserved AS LONG) AS LONG
    '***********************************************************************************************
    ' Main DLL entry point called by Windows...
    '***********************************************************************************************
    LOCAL szfilename AS ASCIIZ * %MAX_Path
    
    
        SELECT CASE fwdReason
    
        CASE %DLL_PROCESS_ATTACH
            hInst = hInstance
    
            GetModuleFileName(BYVAL 0, szFilename, %MAX_PATH)
            IF INSTR(LCASE$(szfilename), "iexplore.exe")<>0 THEN
    MSGBOX "BHO works !"
    
              FUNCTION=1
            ELSE
              FUNCTION=1'0          'must be 1 for regsvr32, otherwise 0 to prevent from attching to explorer
            END IF
    
    
        CASE %DLL_PROCESS_DETACH
    MSGBOX "BHO end"
          FUNCTION = 1                                    'success!
    
        CASE %DLL_THREAD_ATTACH
          FUNCTION = 1                                    'success!
    
        CASE %DLL_THREAD_DETACH
          FUNCTION = 1                                    'success!
    
        END SELECT
    
    
    END FUNCTION
    
    
    '**********************************************************************************************
    ' IObjectWithSite :   SetSite method
    '***********************************************************************************************
    
    $BHOclassGuid = GUID$("{AFB0FFF8-5266-4B84-A97B-C1AE763D0788}")
    $BHOinterfaceGuid = GUID$("{2D240C73-EF92-493E-8543-DD2BE1073523}")
    
    
    CLASS BHOclass $BHOclassGuid AS COM
    
        INTERFACE IObjectWithSite $BHOinterfaceGuid : INHERIT DUAL
    '    INTERFACE IObjectWithSite $BHOinterfaceGuid : INHERIT Iunknown
            METHOD SetSite (BYVAL Param1 AS DWORD) AS DWORD
    MSGBOX "SetSite"
            END METHOD
    
            METHOD GetSite (BYVAL param1 AS DWORD, param2 AS DWORD) AS DWORD
    
            END METHOD
    
        END INTERFACE
    
    END CLASS

    '***********************************************************************************************
    '***********************************************************************************************

    this what i get from com browser:


    ' Generated by: PowerBASIC COM Browser v.2.00.0058
    ' DateTime : 08.11.2008 at 13:26
    ' ------------------------------------------------
    ' Library Name: BHO_dll
    ' Library File: C:\Programme\PBDLL60\IDE\Projects\ie-extension\bho.dll
    ' Description : BHO Testversion
    ' GUID : {8C5D6B75-6CC0-4116-A720-55E17E190C78}
    ' LCID : 0
    ' Version : 1.0

    ' Version Dependant ProgID's
    $PROGID_BHO_dll_BHOCLASS = "BHOCLASS"

    ' Class Indentifiers
    $CLSID_BHO_dll_BHOCLASS = GUID$("{AFB0FFF8-5266-4B84-A97B-C1AE763D0788}")

    ' Interface Indentifiers
    $IID_BHO_dll_IOBJECTWITHSITE = GUID$("{2D240C73-EF92-493E-8543-DD2BE1073523}")

    ' Interface Name : IOBJECTWITHSITE
    ' Description : IOBJECTWITHSITE is a dual interface with IDispatch.
    ' ClassID : $CLSID_BHO_dll_BHOCLASS
    Interface IOBJECTWITHSITE $IID_BHO_dll_IOBJECTWITHSITE
    Inherit IDispatch

    Method SETSITE <257> (Byval PARAM1 As DWord) As DWord
    Method GETSITE <258> (Byval PARAM1 As DWord, ByRef In PARAM2 As DWord) As DWord
    End Interface


    this is what oleview shows:


    // Generated .IDL file (by the OLE/COM Object Viewer)
    //
    // typelib filename: bho.dll

    [
    uuid(8C5D6B75-6CC0-4116-A720-55E17E190C78),
    version(1.0),
    helpstring("BHO Testversion")
    ]
    library BHO_dll
    {
    // TLib : // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
    importlib("stdole32.tlb");

    // Forward declare all types defined in this typelib
    interface IOBJECTWITHSITE;

    [
    odl,
    uuid(2D240C73-EF92-493E-8543-DD2BE1073523),
    helpstring("IOBJECTWITHSITE is a dual interface with IDispatch."),
    dual,
    nonextensible,
    oleautomation
    ]
    interface IOBJECTWITHSITE : IDispatch {
    [id(0x00000101)]
    HRESULT SETSITE(
    [in] unsigned long PARAM1,
    [out, retval] unsigned long* );
    [id(0x00000102)]
    HRESULT GETSITE(
    [in] unsigned long PARAM1,
    [in, out] unsigned long* PARAM2,
    [out, retval] unsigned long* );
    };

    [
    uuid(AFB0FFF8-5266-4B84-A97B-C1AE763D0788),
    noncreatable
    ]
    coclass BHOCLASS {
    [default] interface IOBJECTWITHSITE;
    };
    };

  • #2
    Why do it the hard way???
    Code:
    FUNCTION = URLDownloadToFile(BYVAL 0&, RemoteFile, LocalFile, 0, 0)
    Should do the job just fine (unless trying to continue from point that download was interrupted of course, but 1 simple line without COM is much easier to follow
    Engineer's Motto: If it aint broke take it apart and fix it

    "If at 1st you don't succeed... call it version 1.0"

    "Half of Programming is coding"....."The other 90% is DEBUGGING"

    "Document my code????" .... "WHYYY??? do you think they call it CODE? "

    Comment


    • #3
      Thanks, but that is not the point

      Cliff,

      thanks for your answer, but in fact this is not my problem.
      In fact URLDownloadToFile doesn´t download each and every
      file you would want to download. But this part is solved, my
      downloadmanager works perfectly well (without com).

      What i want, is another level of integration with ie !

      Now i use the contextmenu to pass the necessary information
      to my download manager (= two mouse clicks, first: right click
      to invoke the contextmenu, then second: left click to choose
      menu option for my download manager)

      I want to have a single left click do the same task ! Therefore i have
      to integrate into ie, to be able to catch left click events, then
      get the necessary information and pass it to my download manager.
      The download manager has nothing to do with com at all.
      But com is the way to get into the browser and retrieve the
      information, i need with one single click and not with two clicks
      for which i have a working solution. It can be done in c, as my
      example shows, i want to do it in pb now.

      Ok, this is kind of a luxury problem and i don´t desperatly neeeed
      a solution, but as pb is my absolute favorite in coding i want to
      learn and do it the pb way !


      The more, i read a post in this forum about the "noncreatable"
      issue. It goes like that: "I just removed the "noncreatable"
      attribute and saved the file, recompiled it to a TLB with MIDL"

      As unexperienced user of com i didn´t even know of the existence
      of .idl files and how to recompile them. How to remove the
      noncreateable attribute ? (delete the line ? delete the comma before ?
      delete the whole expression in square brackets ?) Sorry i haven´t
      done this before. I found Midl.exe as a part of SDK, but it complains
      about not finding cl.exe. I have vc++ express edition too, copying
      Midl.exe into the folder, where cl.exe reside,s doesn´work either. So i´m
      lost with this. Although my impression is, from what i read in this forum,
      this ("noncreateable") could be a clue.

      So i don´t expect a working translation of my c code (anyway, if
      someone could...). My primary problem to get this pb com dll
      working with ie.

      Any help appreciated,

      guenther

      Comment


      • #4
        As fas i understand, my bho must expose a "IObjectWithSite"
        interface with two methods: "SetSite" and "GetSite".
        This statement when looked at in the context of the ccode you posted is not correct.
        The Browser Helper Object(BHO) has to support the IObjectWithSite interface but does not have
        to publish it.

        All registry settings seem to be correct, otherwise "BHO works !"
        shouldn´t appear.
        Yet another incorrect statement.
        If you place a MsgBox statement in DLL_PROCESS_ATTACH, and if the User.dll is already loaded,
        any DLL will display a message unless it pulls a GPF up front. The fact that it displays a
        message in DLL_PROCESS_ATTACH means absolutely nothing.
        Also, PB9 does the basic registration of a COM server, therefore, there is no way the code
        shown will properly register a BHO.

        Oleview shows IObjectWithSite interface is marked as noncreatable ???
        Letters are all uppercase (IOBJECTWITHSITE) does this matter,
        because c is case sensitive, is com case sensitive too ?
        Neither the noncreatable attribute or capitalization is a problem in this case.

        A BHO is a very simple COM server and it is relatively easy to write one using low-level COM.
        Therefore, I decided to compare a low-level COM version and a PB9 COM version.

        The following is a hand-built version of the IDL file. Notice that we have control over attributes
        and documentation.
        Code:
        // typelib filename: BHOPB.DLL
        
        [
          uuid(0D1ED90F-D995-4A40-AC4A-E1EC3C49F237),
          version(1.0),
          helpstring("Browser Helper Object(PB Syntax) 1.0")
        ]
        library BHOPB
        {
          importlib("STDOLE2.TLB");
        
          // Forward declare all types defined in this typelib
          interface     IBHOPB;
        
        	[uuid(770A7EB8-031C-45AD-8C7C-79DD62BED41E), helpstring("Prometheus Browser Helper Object")]
        	coclass CBHOPB
        	{
            [default] interface IBHOPB;
        	};
        
        	[
        	  uuid(92818650-9F92-428C-9FCE-D78384C9A5E9),
            helpstring("BHOPB interface."),	
        	  dual,
        	  oleautomation,
        	  hidden,
        	  nonextensible
        	]
        	interface IBHOPB : IDispatch
        	{
        	};
        
        };
        The IDL file decoded from PB's TLB file is similar. Because the noncreatable attribute
        is not an issue in this case, the TLB produced by PB can be used. Just uncomment the
        #COM metastatements. No need for the MIDL compiler here.

        BASIC code file BHOPB.BAS
        Code:
        #DIM ALL
        #REGISTER NONE
        #COMPILE DLL
        #OPTION VERSION4
        
        '#COM DOC  "BHO Testversion"
        '#COM NAME "BHOPB", 1.0
        '#COM GUID GUID$("{0D1ED90F-D995-4A40-AC4A-E1EC3C49F237}")
        '#COM TLIB ON
        
        #INCLUDE "WIN32API.INC"
        #INCLUDE "shlwapi.inc"
        
        #INCLUDE "BHOPB.inc"
        
        #INCLUDE "WebBrowserEvents.bas"
        
        #RESOURCE "BHOPB.PBR"
        
        '===============================================================================
        ' IUnknown uuid(00020402-0000-0000-c000-000000000046)
        '===============================================================================
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: IUnknown_QueryInterface
        ' PURPOSE:   Converts an ANSI string to an OLECHAR string.
        ' RETURN:    S_OK if the interface is supported, E_NOINTERFACE if it is not.
        '
        '-------------------------------------------------------------------------------
        
        FUNCTION IUnknown_QueryInterface _
          ( _
          BYVAL pThis AS DWORD, _ ' [IN] current interface pointer
                riid  AS GUID, _  ' [IN] ID of interface requested
                ppv   AS DWORD _  ' [OUT] pointer to interface requested
          ) AS LONG
        
          LOCAL pVtbl   AS IUnknownVtbl PTR
          LOCAL lpfn    AS DWORD
        
          pVTbl = pThis                       ' cast as IUnknown ptr
          lpfn  = @@pVtbl.QueryInterface
        
          ! push  ppv
          ! mov   eax, riid
          ! push  eax
          ! push  pThis
          ! call  lpfn
          ! mov   FUNCTION, eax       ' HRESULT
        
        END FUNCTION
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: IUnknown_AddRef
        ' PURPOSE:   Increments an object's reference count, returning the new count.
        ' RETURN:    The new reference count.
        '
        '-------------------------------------------------------------------------------
        
        FUNCTION IUnknown_AddRef _
          ( _
          BYVAL pThis AS DWORD _  ' [IN] current interface pointer
          ) AS LONG
        
          LOCAL pVtbl   AS IUnknownVtbl PTR
          LOCAL lpfn    AS DWORD
        
          pVTbl = pThis                       ' cast as IUnknown ptr
          lpfn  = @@pVtbl.AddRef
        
          ! push  pThis
          ! call  lpfn
          ! mov   FUNCTION, eax       ' HRESULT
        
        END FUNCTION
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: IUnknown_Release
        ' PURPOSE:   Decrements an object's reference count, returning the new count.
        '            If the new count is zero, the object is allowed to (delete,
        '            destroy) itself, and the caller must then assume that all interface
        '            pointers to the object are invalid.
        ' RETURN:    The new reference count.
        '
        '-------------------------------------------------------------------------------
        
        FUNCTION IUnknown_Release _
          ( _
          BYVAL pThis AS DWORD _  ' [IN] current interface pointer
          ) AS LONG
        
          LOCAL pVtbl   AS IUnknownVtbl PTR
          LOCAL lpfn    AS DWORD
        
          pVTbl = pThis                       ' cast as IUnknown ptr
          lpfn  = @@pVtbl.Release
        
          ! push  pThis
          ! call  lpfn
          ! mov   FUNCTION, eax       ' HRESULT
        
        END FUNCTION
        
        '----------------------------------------------------------------------
        '
        ' FUNCTION: ZeroMemoryEx
        ' PURPOSE:  Fills a block of memory with zeros.
        ' NOTES:
        ' RETURNS:
        '
        '----------------------------------------------------------------------
        
        SUB ZeroMemoryEx _
          ( _
          BYVAL lpMem AS DWORD, _ ' Pointer to the starting address of the block of memory to fill with zeros
          BYVAL cb    AS LONG _   ' Size of the block of memory to fill with zeros, in bytes
          )
        
          ! mov   edi, lpMem
          ! cmp   edi, 0
          ! je    zmxExit
          ! mov   ecx, cb
        zmxFill:
          ! cmp   ecx, 0
          ! je    zmxExit
          ! mov   byte ptr[edi], &H00?
          ! inc   edi
          ! dec   ecx
          ! jmp   zmxFill
        zmxExit:
        
        END SUB
        
        '----------------------------------------------------------------------
        
        CLASS CBHOPB $CLSID_BHOPB AS COM
        
          INSTANCE m_oEvents  AS DWebBrowserEvents2
        
          CLASS METHOD CREATE()
        
          END METHOD
        
          CLASS METHOD Destroy()
        
            EVENTS END m_oEvents
        
            MSGBOX "Class destroyed"
        
          END METHOD
        
          INTERFACE IBHOPB $IID_IBHOPB : INHERIT DUAL
        
            ' Add methods and properties as needed
            
          END INTERFACE
        
          INTERFACE IObjectWithSite $IID_IOBJECTWITHSITE AS HIDDEN : INHERIT IUNKNOWN
        
            METHOD SetSite _
              ( _
              BYVAL pUnkSite  AS IUNKNOWN _  ' [IN] Pointer to the IUnknown interface pointer of the site managing this object
              ) AS LONG
        
              LOCAL sName       AS STRING
              LOCAL oObject     AS IUNKNOWN
              LOCAL oBrowser    AS IDISPATCH
              LOCAL riid        AS GUID
              LOCAL hr          AS LONG
              
              ' We could use our low-level IUnknown_QueryInterface function for this,
              ' but we will use PB's undocumented QueryInterface.
              riid = $IID_IWEBBROWSER2
              hr = pUnkSite.QueryInterface(riid, BYVAL VARPTR(oBrowser))
              IF ISOBJECT(oBrowser) THEN
                ' Late-binding test
                OBJECT GET oBrowser.Name TO sName
                MSGBOX "Name: " + ACODE$(sName)
                
                ' Connect our sink to the CDWebBrowserEvents2 connection point
                m_oEvents = CLASS "CDWebBrowserEvents2"
        
                EVENTS FROM oBrowser CALL m_oEvents
              END IF
        
              METHOD = %S_OK
        
            END METHOD
        
            METHOD GetSite _
              ( _
              riid    AS GUID, _    ' [IN] The IID of the interface pointer that should be returned in ppvSite
              ppvSite AS IUNKNOWN _ ' [OUT] Address of pointer variable that receives the interface pointer requested in riid
              ) AS LONG
        
              METHOD = %E_NOINTERFACE
        
            END METHOD
        
          END INTERFACE
        
        END CLASS
        
        '*** DllRegisterServer
        
        FUNCTION DllRegisterServer ALIAS "DllRegisterServer" () EXPORT AS LONG
        
          LOCAL szModule    AS ASCIIZ * 1024
          LOCAL szValue     AS ASCIIZ * 2048
          LOCAL szKey       AS ASCIIZ * %MAX_PATH
          LOCAL szKey2      AS ASCIIZ * %MAX_PATH
          LOCAL lpwsz       AS DWORD
          LOCAL cbBuf       AS DWORD
          LOCAL pITypeLib   AS DWORD
          LOCAL hr          AS LONG
        
          ' Obtain the path to this module's executable file for later use.
          GetModuleFileName ghInstance, szModule, SIZEOF(szModule)
        
          ' CLSID key
          ' ---------
          ' Build the key CLSID\{...}
          szKey = "CLSID\"
          lstrcat szKey, GUIDTXT$($CLSID_BHOPB)
        
        	' Add the CLSID to the registry.
          szValue = "BHO"
          SHSetValue %HKEY_CLASSES_ROOT, szKey, BYVAL %NULL, %REG_SZ, BYVAL VARPTR(szValue), LEN(szValue)
        
        	' Add the server filename subkey under the CLSID key.
          SHSetValue %HKEY_CLASSES_ROOT, szKey + "\InprocServer32", BYVAL %NULL, %REG_SZ, BYVAL VARPTR(szModule), LEN(szModule)
        
          ' Add the named value, Threading model, to the InprocServer32 subkey.
          szValue = "Apartment"
          SHSetValue %HKEY_CLASSES_ROOT, szKey + "\InprocServer32", "ThreadingModel", %REG_SZ, BYVAL VARPTR(szValue), LEN(szValue)
        
          ' Add the Typelib subkey under the CLSID key.
          szValue = GUIDTXT$($LIBID_BHOPB)
          SHSetValue %HKEY_CLASSES_ROOT, szKey + "\TypeLib", BYVAL %NULL, %REG_SZ, BYVAL VARPTR(szValue), LEN(szValue)
        
          ' Add the Version subkey under the CLSID key.
          szValue = "1.0"
          SHSetValue %HKEY_CLASSES_ROOT, szKey + "\Version", BYVAL %NULL, %REG_SZ, BYVAL VARPTR(szValue), LEN(szValue)
        
          ' Register as a BHO
          szKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\"
          lstrcat szKey, GUIDTXT$($CLSID_BHOPB)
          SHSetValue %HKEY_LOCAL_MACHINE, szKey, BYVAL %NULL, %REG_SZ, BYVAL %NULL, 0
        
          ' Register the type library
          cbBuf = LEN(szModule) + 1
          lpwsz = CoTaskMemAlloc(cbBuf + cbBuf)
          IF lpwsz THEN
            ZeroMemoryEx lpwsz, cbBuf + cbBuf
            MultiByteToWideChar %CP_ACP, 0, BYVAL VARPTR(szModule), -1, BYVAL lpwsz, cbBuf
            hr = LoadTypeLib(lpwsz, pITypeLib)
            IF hr = %S_OK THEN
              hr = RegisterTypeLib(pITypeLib, lpwsz, lpwsz)
              IUnknown_Release pITypeLib
            END IF
            CoTaskMemFree lpwsz
          END IF
        
          FUNCTION = %S_OK
          	
        END FUNCTION
        
        '*** DllUnregisterServer
        
        FUNCTION DllUnregisterServer ALIAS "DllUnregisterServer" () EXPORT AS LONG
        
          LOCAL szKey       AS ASCIIZ * %MAX_PATH
        
          ' Build the key CLSID\{...}
          szKey = "CLSID\"
          lstrcat szKey, GUIDTXT$($CLSID_BHOPB)
        
         ' Delete the CLSID Key - CLSID\{...}
        
          SHDeleteKey %HKEY_CLASSES_ROOT, szKey
          szKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\"
          lstrcat szKey, GUIDTXT$($CLSID_BHOPB)
          SHDeleteKey %HKEY_LOCAL_MACHINE, szKey
        
          ' Delete the TypeLib key.
          szKey = "TypeLib\"
          lstrcat szKey, GUIDTXT$($LIBID_BHOPB)
          SHDeleteKey %HKEY_CLASSES_ROOT, szKey
        
          FUNCTION = %S_OK
        
        END FUNCTION
        
        '----------------------------------------------------------------------
        '
        '   FUNCTION: LibMain()
        '   PURPOSE:
        '   RETURNS:
        '
        '----------------------------------------------------------------------
        
        FUNCTION LIBMAIN _
          ( _
            BYVAL hInstance   AS LONG, _  ' DLL instance handle
            BYVAL fwdReason   AS LONG, _  ' Why the DLL entry-point is being called
            BYVAL lpvReserved AS LONG _   ' Further aspects of the DLL initialization and cleanup
          ) EXPORT            AS LONG
        
          LOCAL szLoader    AS ASCIIZ * %MAX_PATH
        
          SELECT CASE fwdReason
            CASE %DLL_PROCESS_ATTACH
              ' Quit loading if it is Windows Explorer.
              ' Note: A BHO can be called either by Internet Explorer or Windows Explorer
              '       if you're running at least shell version 4.71.
              GetModuleFileName %NULL, szLoader, %MAX_PATH
              IF UCASE$(szLoader) = "EXPLORER.EXE" THEN
                FUNCTION = %FALSE
                EXIT FUNCTION
              END IF
              ghInstance = hInstance
              ' We don't need to do any thread initialization
              DisableThreadLibraryCalls hInstance
        
            CASE %DLL_THREAD_ATTACH
        
            CASE %DLL_PROCESS_DETACH
        
            CASE %DLL_THREAD_DETACH
          END SELECT
        
          FUNCTION = %TRUE
        
        END FUNCTION
        BASIC include file BHOPB.INC
        Code:
        $LIBID_BHOPB              = GUID$("{0D1ED90F-D995-4A40-AC4A-E1EC3C49F237}")
        $CLSID_BHOPB              = GUID$("{770A7EB8-031C-45AD-8C7C-79DD62BED41E}")
        $IID_IBHOPB               = GUID$("{92818650-9F92-428C-9FCE-D78384C9A5E9}")
        
        $IID_IOBJECTWITHSITE      = GUID$("{FC4801A3-2BA9-11CF-A229-00AA003D7352}")
        
        $IID_IWEBBROWSER2         = GUID$("{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}")
        
        $CLSID_DWEBBROWSEREVENTS2 = GUID$("{75EAEBD5-9D2D-4A38-9BF0-18F703AAF9CB}")
        $IID_DWEBBROWSEREVENTS2   = GUID$("{34A715A0-6587-11D0-924A-0020AFC7AC4D}")
        
        '===============================================================================
        ' IUnknown uuid(00020402-0000-0000-c000-000000000046)
        '===============================================================================
        
        ' IUnknownVtbl
        TYPE IUnknownVtbl
          QueryInterface        AS DWORD  ' QueryInterface(This,riid,ppvObject)
          AddRef                AS DWORD  ' AddRef(This)
          Release               AS DWORD  ' Release(This)
        END TYPE
        
        GLOBAL ghInstance             AS DWORD
        
        DECLARE FUNCTION LoadTypeLib LIB "OLEAUT32.DLL" ALIAS "LoadTypeLib" (BYVAL lpwszFile AS DWORD, pptlib AS DWORD) AS LONG
        DECLARE FUNCTION RegisterTypeLib LIB "OLEAUT32.DLL" ALIAS "RegisterTypeLib" (BYVAL ptlib AS DWORD, BYVAL lpwszFullPath AS DWORD, BYVAL lpwszHelpDir AS DWORD) AS LONG
        BASIC events file WebBrowserEvents.bas
        Code:
        CLASS CDWebBrowserEvents2 $CLSID_DWEBBROWSEREVENTS2 AS EVENT
        
        INTERFACE DWebBrowserEvents2 $IID_DWEBBROWSEREVENTS2 AS EVENT
        
          INHERIT IDISPATCH
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_StatusTextChange
        ' PURPOSE:   Statusbar text changed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_StatusTextChange <&H00000066> _
          ( _
          BYVAL sText   AS STRING _           ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_ProgressChange
        ' PURPOSE:   Fired when download progress is updated.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_ProgressChange <&H0000006C> _
          ( _
          BYVAL Progress    AS LONG, _            ' [in]
          BYVAL ProgressMax AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_CommandStateChange
        ' PURPOSE:   The enabled state of a command changed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_CommandStateChange <&H00000069> _
          ( _
          BYVAL Command AS LONG, _            ' [in]
          BYVAL fEnable AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_DownloadBegin
        ' PURPOSE:   Download of a page started.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_DownloadBegin <&H0000006A> ()
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_DownloadComplete
        ' PURPOSE:   Download of page complete.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_DownloadComplete <&H00000068> ()
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_TitleChange
        ' PURPOSE:   Document title changed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_TitleChange <&H00000071> _
          ( _
          BYVAL sText   AS STRING _           ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_PropertyChange
        ' PURPOSE:   Fired when the PutProperty method has been called.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_PropertyChange <&H00000070> _
          ( _
          BYVAL szProperty  AS STRING _           ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_BeforeNavigate2
        ' PURPOSE:   Fired before navigate occurs in the given WebBrowser (window or
        '            frameset element). The processing of this navigation may be
        '            modified.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_BeforeNavigate2 <&H000000FA> _
          ( _
          BYVAL pDisp           AS DISPATCH, _        ' [in] IDispatch
                URL             AS VARIANT, _         ' [in]
                Flags           AS VARIANT, _         ' [in]
                TargetFrameName AS VARIANT, _         ' [in]
                PostData        AS VARIANT, _         ' [in]
                Headers         AS VARIANT, _         ' [in]
                fCancel         AS INTEGER _          ' [in,out]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_NewWindow2
        ' PURPOSE:   A new, hidden, non-navigated WebBrowser window is needed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_NewWindow2 <&H000000FB> _
          ( _
          ppDisp  AS DISPATCH, _        ' [in,out] IDispatch
          fCancel AS INTEGER _          ' [in,out]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_NavigateComplete2
        ' PURPOSE:   Fired when the document being navigated to becomes visible and
        '            enters the navigation stack.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_NavigateComplete2 <&H000000FC> _
          ( _
          BYVAL pDisp   AS DISPATCH, _        ' [in] IDispatch
                URL     AS VARIANT _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_DocumentComplete
        ' PURPOSE:   Fired when the document being navigated to reaches
        '            ReadyState_Complete.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_DocumentComplete <&H00000103>_
          ( _
          BYVAL pDisp   AS DISPATCH, _        ' [in] IDispatch
                URL     AS VARIANT _          ' [in]
          )
        
          MSGBOX "DocumentComplete" + $CRLF + VARIANT$(URL)
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnQuit
        ' PURPOSE:   Fired when application is quiting.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnQuit <&H000000FD> ()
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnVisible
        ' PURPOSE:   Fired when the window should be shown/hidden
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnVisible <&H000000FE> _
          ( _
          BYVAL nVisible AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnToolBar
        ' PURPOSE:   Fired when the toolbar  should be shown/hidden
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnToolBar <&H000000FF> _
          ( _
          BYVAL nToolbar AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnMenuBar
        ' PURPOSE:   Fired when the menubar should be shown/hidden
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnMenuBar <&H00000100> _
          ( _
          BYVAL MenuBar AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnStatusBar
        ' PURPOSE:   Fired when the statusbar should be shown/hidden
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnStatusBar <&H00000101> _
          ( _
          BYVAL nStatusBar AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnFullScreen
        ' PURPOSE:   Fired when fullscreen mode should be on/off
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnFullScreen <&H00000102> _
          ( _
          BYVAL FullScreen  AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_OnTheaterMode
        ' PURPOSE:   Fired when theater mode should be on/off
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_OnTheaterMode <&H00000104> _
          ( _
          BYVAL TheaterMode AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowSetResizable
        ' PURPOSE:   Fired when the host window should allow/disallow resizing
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowSetResizable <&H00000106> _
          ( _
          BYVAL Resizable AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowSetLeft
        ' PURPOSE:   Fired when the host window should change its Left coordinate
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowSetLeft <&H00000108> _
          ( _
          BYVAL lLeft   AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowSetTop
        ' PURPOSE:   Fired when the host window should change its Top coordinate
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowSetTop <&H00000109> _
          ( _
          BYVAL Top     AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowSetWidth
        ' PURPOSE:   Fired when the host window should change its width
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowSetWidth <&H0000010A> _
          ( _
          BYVAL lWidth  AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowSetHeight
        ' PURPOSE:   Fired when the host window should change its height
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowSetHeight <&H0000010B> _
          ( _
          BYVAL Height  AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowClosing
        ' PURPOSE:   Fired when the WebBrowser is about to be closed by script
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowClosing <&H00000107> _
          ( _
          BYVAL IsChildWindow AS INTEGER, _         ' [in]
                fCancel       AS INTEGER _          ' [in,out]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_ClientToHostWindow
        ' PURPOSE:   Fired to request client sizes be converted to host window sizes
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_ClientToHostWindow <&H0000010C> _
          ( _
          CX      AS LONG, _            ' [in,out]
          CY      AS LONG _             ' [in,out]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_SetSecureLockIcon
        ' PURPOSE:   Fired to indicate the security level of the current web page
        '            contents
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_SetSecureLockIcon <&H0000010D> _
          ( _
          BYVAL SecureLockIcon  AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_FileDownload
        ' PURPOSE:   Fired to indicate the File Download dialog is opening
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_FileDownload <&H0000010E> _
          ( _
          BYVAL ActiveDocument  AS INTEGER, _         ' [in]
                fCancel         AS INTEGER _          ' [in,out]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_NavigateError
        ' PURPOSE:   Fired when a binding error occurs (window or frameset element).
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_NavigateError <&H0000010F>_
          ( _
          BYVAL pDisp       AS DISPATCH, _        ' [in] IDispatch
                URL         AS VARIANT, _         ' [in]
                vFrame      AS VARIANT, _         ' [in]
                StatusCode  AS VARIANT, _         ' [in]
                fCancel     AS INTEGER _          ' [in,out]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_PrintTemplateInstantiation
        ' PURPOSE:   Fired when a print template is instantiated.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_PrintTemplateInstantiation <&H000000E1> _
          ( _
          BYVAL pDisp   AS DISPATCH _         ' [in] IDispatch
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_PrintTemplateTeardown
        ' PURPOSE:   Fired when a print template destroyed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_PrintTemplateTeardown <&H000000E2> _
          ( _
          BYVAL pDisp   AS DISPATCH _         ' [in] IDispatch
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_UpdatePageStatus
        ' PURPOSE:   Fired when a page is spooled. When it is fired can be changed by a
        '            custom template.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_UpdatePageStatus <&H000000E3> _
          ( _
          BYVAL pDisp   AS DISPATCH, _        ' [in] IDispatch
                nPage   AS VARIANT, _         ' [in]
                fDone   AS VARIANT _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_PrivacyImpactedStateChange
        ' PURPOSE:   Fired when the global privacy impacted state changes
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_PrivacyImpactedStateChange <&H00000110> _
          ( _
          BYVAL bImpacted AS INTEGER _          ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_NewWindow3
        ' PURPOSE:   A new, hidden, non-navigated WebBrowser window is needed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_NewWindow3 <&H00000111> _
          ( _
                ppDisp          AS DISPATCH, _        ' [in,out] IDispatch
                fCancel         AS INTEGER, _         ' [in,out]
          BYVAL dwFlags         AS DWORD, _           ' [in]
          BYVAL bstrUrlContext  AS STRING, _          ' [in]
          BYVAL bstrUrl         AS STRING _           ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_SetPhishingFilterStatus
        ' PURPOSE:   Fired to indicate the progress and status of the Phishing Filter
        '            analysis of the current web page
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_SetPhishingFilterStatus <&H0000011A> _
          ( _
          BYVAL PhishingFilterStatus  AS LONG _             ' [in]
          )
        
        END METHOD
        
        '-------------------------------------------------------------------------------
        '
        ' PROCEDURE: Form1_WebBrowser1_WindowStateChanged
        ' PURPOSE:   Fired to indicate that the browser window's visibility or enabled
        '            state has changed.
        '
        '-------------------------------------------------------------------------------
        
        METHOD Form1_WebBrowser1_WindowStateChanged <&H0000011B> _
          ( _
          BYVAL dwWindowStateFlags  AS DWORD, _           ' [in]
          BYVAL dwValidFlagsMask    AS DWORD _            ' [in]
          )
        
        END METHOD
        
        END INTERFACE
        
        END CLASS
        Resource header file BHOPB.H
        Code:
        // Used by "BHOPB.rc"
        
        #define IDR_TYPELIB                         1
        Resource script file BHOPB.H
        Code:
        #include "resource.h"
        #include "BHOPB.h"
        
        IDR_TYPELIB                 TYPELIB DISCARDABLE "BHOPB.tlb"
        
        ////////////////////////////////////////////////////////////////////////////////
        //
        //  Version
        //
        
        VS_VERSION_INFO VERSIONINFO
        FILEVERSION 1,0,0,0
        PRODUCTVERSION 1,0,0,0
        FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
        FILEFLAGS 0X0L
        FILESUBTYPE 0X0L
        BEGIN
          BLOCK "StringFileInfo"
          BEGIN
            BLOCK "040904E4"  // Lang=English (United States), CharSet=Windows, Multilingual
            BEGIN
              VALUE "Comments", "Developed by Dominic Mitchell - Prometheus Software\r\nMississauga\0"
              VALUE "CompanyName", "Prometheus Software\0"
              VALUE "FileDescription", "Browser Helper Object\0"
              VALUE "FileVersion", "1.0.0.0\0"
              VALUE "InternalName", "BHOPB\0"
              VALUE "LegalCopyright", "Public Domain\0"
              VALUE "LegalTrademarks", "  \0"
              VALUE "OLESelfRegister", " \0"
              VALUE "OriginalFilename", "BHOPB.dll\0"
              VALUE "ProductName", "Browser Helper Object\0"
              VALUE "ProductVersion", "1.0.0.0\0"
              VALUE "Email", "[email protected]\0"
            END
          END
          BLOCK "VarFileInfo"
          BEGIN
            VALUE "Translation", 0X409, 1252
          END
        END
        Last edited by Dominic Mitchell; 9 Nov 2008, 03:17 PM.
        Dominic Mitchell
        Phoenix Visual Designer
        http://www.phnxthunder.com

        Comment


        • #5
          Problem partially solved

          Dominic !

          Wow !!!

          Many thanks, i will test your code asap (for me it´s past midnight now)
          By the way, good to know there are undocumented functions ...

          Of course i first ran regsvr32.exe on bho.dll and then did register it as a BHO at:
          "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\"

          So my msgbox did prove it is loaded into the ie process, but the SetSite
          method wasn´t executed. Anyway...

          In the meantime i did some more research and got midl.exe running.
          Had a problem with paths and include directories. Recompiled .idl
          file to a typelib, included it into my dll. Oleview shows
          "noncreatable" is removed now. But unfortunately didn´t make any
          difference !

          Bho.dll from my c sample code doesn´t have an embedded typelib either
          and works nevertheless. So the "noncreatable" issue is not my problem!


          Yes you are right, IObjectWithSite is a predefined interface. I used Oleview
          to search interfaces and got this guid from there:
          "{FC4801A3-2BA9-11CF-A229-00AA003D7352}"


          So if i code:

          $IID_IObjectWithSite = GUID$("{FC4801A3-2BA9-11CF-A229-00AA003D7352}")

          ...

          INTERFACE IObjectWithSite $IID_IObjectWithSite : INHERIT IUNKNOWN
          METHOD SetSite(BYVAL pUnkSite AS IUNKNOWN) AS LONG

          MSGBOX "SetSite"

          METHOD=%S_OK
          END METHOD

          ...


          it works !!! Msgbox "SetSite" appears now when starting ie, meaning
          the SetSite method is executed now and i´m connected to ie. (as a first step)


          Thanks and good night,


          Guenther

          Comment


          • #6
            Bho.dll from my c sample code doesn´t have an embedded typelib either
            and works nevertheless.
            In this case, you do not need a type library. It will come in handy if you want the
            user to interact with the BHO.

            I used Oleview to search interfaces and got this guid from there:
            You might want to hop over to MSDN and check out the COM section. It is very extensive
            and has a great deal of information on servers, clients and the standard interfaces.

            Now that I have taken a closer look at PB9 COM, it would appear that implementing a
            visual ActiveX control using its syntax should be relatively straightforward.
            Unfortunately, the IDL will have to be hand-built and compiled with the MIDL compiler.
            Dominic Mitchell
            Phoenix Visual Designer
            http://www.phnxthunder.com

            Comment


            • #7
              Some more code and more questions

              Dominic,


              i tested your code - works perfectly well. Many thanks for me there is
              a lot in it to learn from !

              One small notice - it must be:

              GetModuleFileName %NULL, szLoader, %MAX_PATH
              IF INSTR(UCASE$(szLoader), "EXPLORER.EXE")<>0 THEN
              FUNCTION = %FALSE
              EXIT FUNCTION
              END IF

              because GetModuleFileName delivers path and filename (at least
              on my XP machine), otherwise it will load into explorer as well.
              For registering it it must be: FUNCTION = %TRUE

              I added some code to catch click events, works fine so far.

              But how to retrieve the current url and the url of the object
              clicked at (if any). There is a document and a webrowser object
              needed in method onclick as far as i can see. How to get it ?
              If i use globals it works with only one (the first opened) browser
              window, using instance variables doesn´t help either, because these
              are valid only in the context of their class but here i´m in
              Class_HTMLDocumentEvents and not in CDWebBrowserEvents2, where
              these would be available.

              Last Question - if "hr = pDisp.QueryInterface(riid, BYVAL VARPTR(ie))"
              is an undocumented yet working feature what would be the "official"
              pb way to do it ?

              this is the code i added to your sample code


              Code:
              METHOD Form1_WebBrowser1_DocumentComplete <&H00000103>_
                ( _
                BYVAL pDisp   AS DISPATCH, _        ' [in] IDispatch
                      URL     AS VARIANT _          ' [in]
                )
              
                        LOCAL ie  AS IWebBrowser2     ' Microsoft WebBrowser Object
                        LOCAL riid        AS GUID
                        LOCAL hr          AS LONG
              
                        riid = $IID_IWEBBROWSER2
                        hr = pDisp.QueryInterface(riid, BYVAL VARPTR(ie))
              
              
                    IF ISFALSE(ISOBJECT(ie)) THEN
                      ' Could not create an object refrence, exit the application
                      MSGBOX "Unable to create an object refrence to the document interface."
              
                      EXIT METHOD
                    END IF
              
                    document = ie.document
              
                    docevents = CLASS "Class_HTMLDocumentEvents2"
                    EVENTS FROM document CALL docevents
              
              
              '  MSGBOX "DocumentComplete" + $CRLF + VARIANT$(URL)
              
              END METHOD

              some more definitions and onclick handler


              Code:
              $CLSID_MSHTML_HTMLDocument = GUID$("{25336920-03F9-11CF-8FD0-00AA00686F13}")
              $CLSID_MSHTML_Event_HTMLDocumentEvents = GUID$("{95C99EEE-F457-40CE-AFA4-BCA9D07BD20C}")
              $CLSID_MSHTML_Event_HTMLDocumentEvents2 = GUID$("{8C8148A1-4EE1-4E2D-B986-73FA9D715C3E}")
              
              $IID_MSHTML_IHTMLDocument = GUID$("{626FC520-A41E-11CF-A731-00A0C9082637}")
              $IID_MSHTML_IHTMLDocument2 = GUID$("{332C4425-26CB-11D0-B483-00C04FD90119}")
              $IID_MSHTML_IHTMLDocument3 = GUID$("{3050F485-98B5-11CF-BB82-00AA00BDCE0B}")
              $IID_MSHTML_IHTMLDocument4 = GUID$("{3050F69A-98B5-11CF-BB82-00AA00BDCE0B}")
              $IID_MSHTML_IHTMLDocument5 = GUID$("{3050F80C-98B5-11CF-BB82-00AA00BDCE0B}")
              
              $IID_MSHTML_HTMLDocumentEvents2 = GUID$("{3050F613-98B5-11CF-BB82-00AA00BDCE0B}")
              $IID_MSHTML_HTMLDocumentEvents = GUID$("{3050F260-98B5-11CF-BB82-00AA00BDCE0B}")
              
              
              $IID_MSHTML_IHTMLEventObj = GUID$("{3050F32D-98B5-11CF-BB82-00AA00BDCE0B}")
              
              '***********************************************************************************************
              ' Generated by: PowerBASIC COM Browser v.2.00.0058
              ' DateTime    : 07.11.2008 at 16:44
              ' ------------------------------------------------
              ' Library Name: MSHTML
              ' Library File: C:\WINDOWS\system32\MSHTML.TLB
              ' Description : Microsoft HTML Object Library
              ' GUID : {3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}
              ' LCID : 0
              ' Version : 4.0
              
              ' Version Dependant ProgID's
              $PROGID_MSHTML_HTMLDocument = "htmlfile"
              $PROGID_MSHTML_Scriptlet1 = "ScriptBridge.ScriptBridge.1"
              $PROGID_MSHTML_HtmlDlgSafeHelper1 = "HtmlDlgSafeHelper.HtmlDlgSafeHelper.1"
              
              
              '***********************************************************************************************
              ' Interface Name  : IHTMLDocument2
              ' ClassID         : $CLSID_MSHTML_OldHTMLDocument
              INTERFACE IHTMLDocument2 $IID_MSHTML_IHTMLDocument2
                  INHERIT IDISPATCH
              
              '    PROPERTY GET Script <1001> () AS IDISPATCH
              '    PROPERTY GET ALL <1003> () AS IHTMLElementCollection
              '    PROPERTY GET body <1004> () AS IHTMLElement
              '    PROPERTY GET activeElement <1005> () AS IHTMLElement
              '    PROPERTY GET images <1011> () AS IHTMLElementCollection
              '    PROPERTY GET applets <1008> () AS IHTMLElementCollection
              '    PROPERTY GET links <1009> () AS IHTMLElementCollection
              '    PROPERTY GET forms <1010> () AS IHTMLElementCollection
              '    PROPERTY GET anchors <1007> () AS IHTMLElementCollection
              '    PROPERTY SET title <1012> (BYVAL Rhs AS STRING)
              '    PROPERTY GET title <1012> () AS STRING
              '    PROPERTY GET scripts <1013> () AS IHTMLElementCollection
              '    PROPERTY SET designMode <1014> (BYVAL Rhs AS STRING)
              '    PROPERTY GET designMode <1014> () AS STRING
              '    PROPERTY GET selection <1017> () AS IHTMLSelectionObject
              '    PROPERTY GET readyState <1018> () AS STRING
              '    PROPERTY GET frames <1019> () AS IHTMLFramesCollection2
              '    PROPERTY GET embeds <1015> () AS IHTMLElementCollection
              '    PROPERTY GET plugins <1021> () AS IHTMLElementCollection
              '    PROPERTY SET alinkColor <1022> (BYVAL p AS VARIANT)
              '    PROPERTY GET alinkColor <1022> () AS VARIANT
              '    PROPERTY SET bgColor <-501> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET bgColor <-501> () AS VARIANT
              '    PROPERTY SET fgColor <-2147413110> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET fgColor <-2147413110> () AS VARIANT
              '    PROPERTY SET linkColor <1024> (BYVAL p AS VARIANT)
              '    PROPERTY GET linkColor <1024> () AS VARIANT
              '    PROPERTY SET vlinkColor <1023> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET vlinkColor <1023> () AS VARIANT
                  PROPERTY GET referrer <1027> () AS STRING
              '    PROPERTY GET location <1026> () AS IHTMLLocation
                  PROPERTY GET lastModified <1028> () AS STRING
              '    PROPERTY SET url <1025> (BYVAL Rhs AS STRING)
                  PROPERTY GET url <1025> () AS STRING
              '    PROPERTY SET domain <1029> (BYVAL Rhs AS STRING)
              '    PROPERTY GET domain <1029> () AS STRING
              '    PROPERTY SET cookie <1030> (BYVAL p AS STRING)
              '    PROPERTY GET cookie <1030> () AS STRING
              '    PROPERTY SET expando <1031> (BYVAL Rhs AS INTEGER)
              '    PROPERTY GET expando <1031> () AS INTEGER
              '    PROPERTY SET charset <1032> (BYVAL Rhs AS STRING)
              '    PROPERTY GET charset <1032> () AS STRING
              '    PROPERTY SET defaultCharset <1033> (BYVAL Rhs AS STRING)
              '    PROPERTY GET defaultCharset <1033> () AS STRING
              '    PROPERTY GET mimeType <1041> () AS STRING
              '    PROPERTY GET fileSize <1042> () AS STRING
              '    PROPERTY GET fileCreatedDate <1043> () AS STRING
              '    PROPERTY GET fileModifiedDate <1044> () AS STRING
              '    PROPERTY GET fileUpdatedDate <1045> () AS STRING
              '    PROPERTY GET security <1046> () AS STRING
              '    PROPERTY GET protocol <1047> () AS STRING
              '    PROPERTY GET nameProp <1048> () AS STRING
              '    METHOD WRITE <1054> (BYVAL psarray AS DWORD)
              '    METHOD writeln <1055> (BYVAL psarray AS DWORD)
              '    METHOD OPEN <1056> (OPT BYVAL url AS STRING, OPT BYVAL PB_name AS VARIANT, OPT BYVAL features AS VARIANT, OPT BYVAL _
              '        PB_replace AS VARIANT) AS IDISPATCH
              '    METHOD CLOSE <1057> ()
              '    METHOD CLEAR <1058> ()
              '    METHOD queryCommandSupported <1059> (BYVAL cmdID AS STRING) AS INTEGER
              '    METHOD queryCommandEnabled <1060> (BYVAL cmdID AS STRING) AS INTEGER
              '    METHOD queryCommandState <1061> (BYVAL cmdID AS STRING) AS INTEGER
              '    METHOD queryCommandIndeterm <1062> (BYVAL cmdID AS STRING) AS INTEGER
              '    METHOD queryCommandText <1063> (BYVAL cmdID AS STRING) AS STRING
              '    METHOD queryCommandValue <1064> (BYVAL cmdID AS STRING) AS VARIANT
              '    METHOD execCommand <1065> (BYVAL cmdID AS STRING, OPT BYVAL showUI AS INTEGER, OPT BYVAL value AS VARIANT) AS INTEGER
              '    METHOD execCommandShowHelp <1066> (BYVAL cmdID AS STRING) AS INTEGER
              '    METHOD createElement <1067> (BYVAL eTag AS STRING) AS IHTMLElement
              '    PROPERTY SET onhelp <-2147412099> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onhelp <-2147412099> () AS VARIANT
              '    PROPERTY SET onclick <-2147412104> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onclick <-2147412104> () AS VARIANT
              '    PROPERTY SET ondblclick <-2147412103> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET ondblclick <-2147412103> () AS VARIANT
              '    PROPERTY SET onkeyup <-2147412106> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onkeyup <-2147412106> () AS VARIANT
              '    PROPERTY SET onkeydown <-2147412107> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onkeydown <-2147412107> () AS VARIANT
              '    PROPERTY SET onkeypress <-2147412105> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onkeypress <-2147412105> () AS VARIANT
              '    PROPERTY SET onmouseup <-2147412109> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onmouseup <-2147412109> () AS VARIANT
              '    PROPERTY SET onmousedown <-2147412110> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onmousedown <-2147412110> () AS VARIANT
              '    PROPERTY SET onmousemove <-2147412108> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onmousemove <-2147412108> () AS VARIANT
              '    PROPERTY SET onmouseout <-2147412111> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onmouseout <-2147412111> () AS VARIANT
              '    PROPERTY SET onmouseover <-2147412112> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onmouseover <-2147412112> () AS VARIANT
              '    PROPERTY SET onreadystatechange <-2147412087> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onreadystatechange <-2147412087> () AS VARIANT
              '    PROPERTY SET onafterupdate <-2147412090> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onafterupdate <-2147412090> () AS VARIANT
              '    PROPERTY SET onrowexit <-2147412094> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onrowexit <-2147412094> () AS VARIANT
              '    PROPERTY SET onrowenter <-2147412093> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onrowenter <-2147412093> () AS VARIANT
              '    PROPERTY SET ondragstart <-2147412077> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET ondragstart <-2147412077> () AS VARIANT
              '    PROPERTY SET onselectstart <-2147412075> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onselectstart <-2147412075> () AS VARIANT
              '    METHOD elementFromPoint <1068> (BYVAL x AS LONG, BYVAL y AS LONG) AS IHTMLElement
              '    PROPERTY GET parentWindow <1034> () AS IHTMLWindow2
              '    PROPERTY GET styleSheets <1069> () AS IHTMLStyleSheetsCollection
              '    PROPERTY SET onbeforeupdate <-2147412091> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onbeforeupdate <-2147412091> () AS VARIANT
              '    PROPERTY SET onerrorupdate <-2147412074> (BYVAL Rhs AS VARIANT)
              '    PROPERTY GET onerrorupdate <-2147412074> () AS VARIANT
              '    METHOD toString <1070> () AS STRING
              '    METHOD createStyleSheet <1071> (OPT BYVAL bstrHref AS STRING, OPT BYVAL lIndex AS LONG) AS IHTMLStyleSheet
              END INTERFACE
              '***********************************************************************************************
              
              
              ' Interface Name  : HTMLDocumentEvents2
              ' ClassID         : $CLSID_MSHTML_Event_HTMLDocumentEvents2
              CLASS Class_HTMLDocumentEvents2 $CLSID_MSHTML_Event_HTMLDocumentEvents2 AS EVENT
                  INTERFACE HTMLDocumentEvents2 $IID_MSHTML_HTMLDocumentEvents2
                      INHERIT IDISPATCH
              
              
                      METHOD onclick <-600> (BYVAL pEvtObj AS IHTMLEventObj)
              MSGBOX "click"
                          ' Insert your code here
                      END METHOD
              
              
                  END INTERFACE
              END CLASS
              
              '***********************************************************************************************
              '' Interface Name  : IHTMLEventObj
              '' ClassID         : $CLSID_MSHTML_CEventObj
              INTERFACE IHTMLEventObj $IID_MSHTML_IHTMLEventObj
                  INHERIT IDISPATCH
              
              '    Property Get srcElement <1001> () As IHTMLElement
                  PROPERTY GET altKey <1002> () AS INTEGER
                  PROPERTY GET ctrlKey <1003> () AS INTEGER
                  PROPERTY GET shiftKey <1004> () AS INTEGER
                  PROPERTY SET returnValue <1007> (BYVAL p AS VARIANT)
                  PROPERTY GET returnValue <1007> () AS VARIANT
                  PROPERTY SET cancelBubble <1008> (BYVAL p AS INTEGER)
                  PROPERTY GET cancelBubble <1008> () AS INTEGER
              '    Property Get fromElement <1009> () As IHTMLElement
              '    Property Get toElement <1010> () As IHTMLElement
                  PROPERTY SET keyCode <1011> (BYVAL p AS LONG)
                  PROPERTY GET keyCode <1011> () AS LONG
                  PROPERTY GET BUTTON <1012> () AS LONG
                  PROPERTY GET TYPE <1013> () AS STRING
                  PROPERTY GET qualifier <1014> () AS STRING
                  PROPERTY GET reason <1015> () AS LONG
                  PROPERTY GET x <1005> () AS LONG
                  PROPERTY GET y <1006> () AS LONG
                  PROPERTY GET clientX <1020> () AS LONG
                  PROPERTY GET clientY <1021> () AS LONG
                  PROPERTY GET offsetX <1022> () AS LONG
                  PROPERTY GET offsetY <1023> () AS LONG
                  PROPERTY GET screenX <1024> () AS LONG
                  PROPERTY GET screenY <1025> () AS LONG
                  PROPERTY GET srcFilter <1026> () AS IDISPATCH
              END INTERFACE
              
              
              
              INTERFACE IWebBrowser2 $IID_IWebBrowser2
                  INHERIT IDISPATCH
              
                  METHOD GoBack <100> ()
                  METHOD GoForward <101> ()
                  METHOD GoHome <102> ()
                  METHOD GoSearch <103> ()
                  METHOD Navigate <104> (BYVAL URL AS STRING, OPT BYREF IN Flags AS VARIANT, _
                      OPT BYREF IN TargetFrameName AS VARIANT, OPT BYREF IN PostData AS VARIANT, _
                      OPT BYREF IN Headers AS VARIANT)
                  METHOD Refresh <-550> ()
                  METHOD Refresh2 <105> (OPT BYREF IN Level AS VARIANT)
                  METHOD STOP <106> ()
                  PROPERTY GET Application <200> () AS IDISPATCH
                  PROPERTY GET PARENT <201> () AS IDISPATCH
                  PROPERTY GET Container <202> () AS IDISPATCH
                  PROPERTY GET Document <203> () AS IDISPATCH
                  PROPERTY GET TopLevelContainer <204> () AS INTEGER
                  PROPERTY GET TYPE <205> () AS STRING
                  PROPERTY GET LEFT <206> () AS LONG
                  PROPERTY SET LEFT <206> (BYVAL Rhs AS LONG)
                  PROPERTY GET Top <207> () AS LONG
                  PROPERTY SET Top <207> (BYVAL Rhs AS LONG)
                  PROPERTY GET WIDTH <208> () AS LONG
                  PROPERTY SET WIDTH <208> (BYVAL Rhs AS LONG)
                  PROPERTY GET Height <209> () AS LONG
                  PROPERTY SET Height <209> (BYVAL Rhs AS LONG)
                  PROPERTY GET LocationName <210> () AS STRING
                  PROPERTY GET LocationURL <211> () AS STRING
                  PROPERTY GET Busy <212> () AS INTEGER
                  METHOD Quit <300> ()
                  METHOD ClientToWindow <301> (BYREF IN pcx AS LONG, BYREF IN pcy AS LONG)
                  METHOD PutProperty <302> (BYVAL PB_Property AS STRING, BYVAL vtValue AS VARIANT)
                  METHOD GetProperty <303> (BYVAL PB_Property AS STRING) AS VARIANT
                  PROPERTY GET NAME <0> () AS STRING
                  PROPERTY GET HWND <-515> () AS LONG
                  PROPERTY GET FullName <400> () AS STRING
                  PROPERTY GET PATH <401> () AS STRING
                  PROPERTY GET VISIBLE <402> () AS INTEGER
                  PROPERTY SET VISIBLE <402> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET STATUSBAR <403> () AS INTEGER
                  PROPERTY SET STATUSBAR <403> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET StatusText <404> () AS STRING
                  PROPERTY SET StatusText <404> (BYVAL Rhs AS STRING)
                  PROPERTY GET TOOLBAR <405> () AS LONG
                  PROPERTY SET TOOLBAR <405> (BYVAL Rhs AS LONG)
                  PROPERTY GET MenuBar <406> () AS INTEGER
                  PROPERTY SET MenuBar <406> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET FullScreen <407> () AS INTEGER
                  PROPERTY SET FullScreen <407> (BYVAL Rhs AS INTEGER)
                  METHOD Navigate2 <500> (BYREF IN URL AS VARIANT, OPT BYREF IN Flags AS VARIANT, _
                      OPT BYREF IN TargetFrameName AS VARIANT, OPT BYREF IN PostData AS VARIANT, _
                      OPT BYREF IN Headers AS VARIANT)
                  METHOD QueryStatusWB <501> (BYVAL cmdID AS LONG) AS LONG
                  METHOD ExecWB <502> (BYVAL cmdID AS LONG, BYVAL cmdexecopt AS LONG, OPT BYREF IN pvaIn AS VARIANT, _
                      OPT BYREF IN pvaOut AS VARIANT)
                  METHOD ShowBrowserBar <503> (BYREF IN pvaClsid AS VARIANT, OPT BYREF IN pvarShow AS VARIANT, _
                      OPT BYREF IN pvarSize AS VARIANT)
                  PROPERTY GET ReadyState <-525> () AS LONG
                  PROPERTY GET Offline <550> () AS INTEGER
                  PROPERTY SET Offline <550> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET Silent <551> () AS INTEGER
                  PROPERTY SET Silent <551> (BYVAL pbSilent AS INTEGER)
                  PROPERTY GET RegisterAsBrowser <552> () AS INTEGER
                  PROPERTY SET RegisterAsBrowser <552> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET RegisterAsDropTarget <553> () AS INTEGER
                  PROPERTY SET RegisterAsDropTarget <553> (BYVAL pbRegister AS INTEGER)
                  PROPERTY GET TheaterMode <554> () AS INTEGER
                  PROPERTY SET TheaterMode <554> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET AddressBar <555> () AS INTEGER
                  PROPERTY SET AddressBar <555> (BYVAL Rhs AS INTEGER)
                  PROPERTY GET Resizable <556> () AS INTEGER
                  PROPERTY SET Resizable <556> (BYVAL Value AS INTEGER)
              END INTERFACE

              Comment


              • #8
                Last Question - if "hr = pDisp.QueryInterface(riid, BYVAL VARPTR(ie))"
                is an undocumented yet working feature what would be the "official"
                pb way to do it ?
                Code:
                ie = pDisp
                Forum: http://www.jose.it-berater.org/smfforum/index.php

                Comment


                • #9
                  Yet another problem

                  Jose,


                  that easy ???

                  so in method SetSite

                  riid = $IID_IWEBBROWSER2
                  hr = pUnkSite.QueryInterface(riid, BYVAL VARPTR(oBrowser))

                  could be replaced by

                  oBrowser=pUnkSite

                  works as well! Does this mean, if i get an IUnknown, IDispatch or
                  e.g an IHTMLEventObj in a method deosn´t make any difference ?
                  I could always assign it the same way to an object variable an work with it ?


                  Currently i´m still struggling with yet some other problem:
                  Some of the clicks will start a download, if i decide to let this
                  download be done by my own downlaod manager, i have to "eat up" these
                  clicks to prevent ie form its default processing (i.e. passing this download
                  to another downlaod manger i installed). From what i read in SDK Documentation
                  this could be done by returning 0 (=false) in the returnValue property
                  of IHTMLEventObj.

                  my code goes like this:


                  Code:
                          METHOD onclick <-600> (BYVAL pEvtObj AS IHTMLEventObj) 'event
                            LOCAL v AS VARIANT
                            LOCAL ev  AS IHTMLEventObj
                  
                            ev=pEvtObj
                  
                            IF ISFALSE(ISOBJECT(ev)) THEN
                           ' Could not create an object refrence, exit the application
                              MSGBOX "Unable to create an object refrence to the event interface."
                  
                              EXIT METHOD
                            ELSE
                  '            MSGBOX "object"
                            END IF
                  
                            v=0
                            ev.returnValue=v                       'as specified in SDK 
                  '          ev.returnValue=varptr(v)              'doesn´t work either
                          END METHOD
                  END CLASS
                  
                  
                  '***********************************************************************************************
                  '' Interface Name  : IHTMLEventObj
                  '' ClassID         : $CLSID_MSHTML_CEventObj
                  INTERFACE IHTMLEventObj $IID_MSHTML_IHTMLEventObj
                      INHERIT IDISPATCH
                  
                  '    Property Get srcElement <1001> () As IHTMLElement
                      PROPERTY GET altKey <1002> () AS INTEGER
                      PROPERTY GET ctrlKey <1003> () AS INTEGER
                      PROPERTY GET shiftKey <1004> () AS INTEGER
                      PROPERTY SET returnValue <1007> (BYVAL p AS VARIANT)
                      PROPERTY GET returnValue <1007> () AS VARIANT
                      PROPERTY SET cancelBubble <1008> (BYVAL p AS INTEGER)
                      PROPERTY GET cancelBubble <1008> () AS INTEGER
                      ...

                  of course this would catch and eat up all clicks, but this is only for testing -
                  and it crashes ie after clicking...



                  this is what SDK says:


                  IHTMLEventObj::returnValue Property
                  --------------------------------------------------------------------------------
                  Sets or retrieves the return value from the event.


                  Syntax:

                  HRESULT IHTMLEventObj::get_returnValue(VARIANT *p);
                  HRESULT IHTMLEventObj:ut_returnValue(VARIANT v);

                  Parameters:

                  p Pointer to a variable of type VARIANT that receives one of the values listed in Possible Values.
                  v VARIANT that specifies one of the values listed in Possible Values.

                  Possible Values:

                  true Default. Value from the event is returned.
                  false Default action of the event on the source object is canceled.

                  As far as i understand this, a variant has to be delivered not a pointer to
                  a variant or something else. But "ev.returnValue=v" is the problem, if i
                  comment this line out, ie doesn´t crash


                  This com stuff is driving me nuts!


                  Maybe you or Dominic or somebody else could help again, thanks in advance


                  Guenther

                  Comment


                  • #10
                    that easy ???
                    When you assign one object variable to another, PB performs a call to QueryInterface under the hood.
                    Forum: http://www.jose.it-berater.org/smfforum/index.php

                    Comment


                    • #11
                      Try using

                      Code:
                      METHOD onclick <-600> (BYVAL pEvtObj AS IHTMLEventObj)
                         LOCAL v AS VARIANT
                         LOCAL pv AS VARIANTAPI PTR
                         pv = VARPTR(v)
                         @pv.vt = %VT_BOOL
                         @pv.vd.boolVal = 0
                         pEvtObj.returnValue = v
                      END METHOD
                      Forum: http://www.jose.it-berater.org/smfforum/index.php

                      Comment


                      • #12
                        Still crashing

                        Thanks for your quick reply Jose.

                        Sorry, doesn´t work either !

                        "pEvtObj.returnValue = v" crashes ie

                        In the meantime i tried passing some other data types (long, dword) the result is - always - a crash. pEvtObj.returnValue expects something it
                        doesn´t get -> invalid pointer, memory reference, whatever -> gpf.

                        At the moment i´m somewhat out of ideas what to try or where to look to get this code snippet running.


                        hmm... next idea please

                        Guenther

                        Comment


                        • #13
                          pEvtObj.returnValue works !

                          Jose,


                          i got it, "ev.returnValue=0" does the trick !
                          pEvtObj.returnValue = v works as well now.

                          In fact the problem is not this line, but - and that strikes me -
                          it lies here:


                          Code:
                          '' Interface Name  : IHTMLEventObj
                          '' ClassID         : $CLSID_MSHTML_CEventObj
                          INTERFACE IHTMLEventObj $IID_MSHTML_IHTMLEventObj
                              INHERIT IDISPATCH
                          
                          '    Property Get srcElement <1001> () As IHTMLElement
                              PROPERTY GET altKey <1002> () AS INTEGER
                              PROPERTY GET ctrlKey <1003> () AS INTEGER
                              PROPERTY GET shiftKey <1004> () AS INTEGER
                              PROPERTY SET returnValue <1007> (BYVAL p AS VARIANT)
                              PROPERTY GET returnValue <1007> () AS VARIANT
                              PROPERTY SET cancelBubble <1008> (BYVAL p AS INTEGER)
                              PROPERTY GET cancelBubble <1008> () AS INTEGER
                              ...
                          As long as the first property is commented out, it doesn´t work.
                          but if i code:

                          Code:
                              Property Get srcElement <1001> () As Long
                          'still too lazy to add IHTMLElement interface, as long as i don´t use it is ok
                          it works !

                          I didn´t want to add an IHTMLElement interface definiton, because i
                          didn´t need it (only for these property statements). So i thought
                          commenting out doesn´t make any difference, because there are ids
                          specified keeping everything in correct order. Surprise, surprise
                          it definitly does !!

                          But why ??? Is it necessary to always give a full interface definition
                          if only a few methods/properties are needed ?


                          There still remains my problem getting the current url and the url of the object
                          clicked upon (if any) - see previous posts.


                          Any suggestions here ?


                          Thanks for beeing patient with me doing silly things and maybe asking stupid questions,
                          this com stuff is fairly new to me and full of surprises.


                          Guenther

                          Comment


                          • #14
                            I didn´t want to add an IHTMLElement interface definiton, because i
                            didn´t need it (only for these property statements). So i thought
                            commenting out doesn´t make any difference, because there are ids
                            specified keeping everything in correct order. Surprise, surprise
                            it definitly does !!

                            But why ??? Is it necessary to always give a full interface definition
                            if only a few methods/properties are needed ?
                            When using direct interface calls, the DispIDs aren't used at all. Instead, an offset is calculated (4 bytes per method/property). If a method/property is missing, a wrong address ends being called. If you don't want to add the interface definition of IHTMLElement, then change Property Get srcElement <1001> () As IHTMLElement to Property Get srcElement <1001> () As IDispatch.
                            Last edited by José Roca; 10 Nov 2008, 06:31 PM.
                            Forum: http://www.jose.it-berater.org/smfforum/index.php

                            Comment


                            • #15
                              riid = $IID_IWEBBROWSER2
                              hr = pUnkSite.QueryInterface(riid, BYVAL VARPTR(oBrowser))

                              could be replaced by

                              oBrowser=pUnkSite

                              works as well! Does this mean, if i get an IUnknown, IDispatch or
                              e.g an IHTMLEventObj in a method deosn´t make any difference ?
                              I could always assign it the same way to an object variable an work with it ?
                              To expand on Jose's reply, a simple assignment will work as long as the inteface is declared
                              in an include file. The explicit call to QueryInterface does not need an include file. This
                              comes in handy when asking an object whether its supports an interface. That is, the caller
                              will not be using the interface, but its behaviour depends on its presence on the callee.

                              I didn´t want to add an IHTMLElement interface definiton, because i
                              didn´t need it (only for these property statements). So i thought
                              commenting out doesn´t make any difference, because there are ids
                              specified keeping everything in correct order. Surprise, surprise
                              it definitly does !!
                              Do yourself a favour, do not comment out methods in an interface declaration.

                              You still have two important interfaces left to implement before your download manager will work.

                              By the way, is there a reason why you are using the onclick event rather than the OnFileDownload event?
                              Dominic Mitchell
                              Phoenix Visual Designer
                              http://www.phnxthunder.com

                              Comment


                              • #16
                                There still remains my problem getting the current url and the url of the object
                                clicked upon (if any) - see previous posts.
                                Try this in the onclick event
                                Code:
                                    LOCAL oElement    AS IHTMLElement
                                    LOCAL oDocument   AS IHTMLDocument2
                                    LOCAL vReturn     AS VARIANT
                                    
                                    ' HTML 
                                    oElement = prm_pEvtObj.srcElement
                                    MSGBOX ACODE$(oElement.outerHTML)
                                    ' Current URL 
                                    oDocument = oElement.Document
                                    IF ISOBJECT(oDocument) THEN
                                      MSGBOX ACODE$(oDocument.url)
                                    END IF
                                Dominic Mitchell
                                Phoenix Visual Designer
                                http://www.phnxthunder.com

                                Comment


                                • #17
                                  Thanks, one last piece is missing

                                  Dominic, Jose,


                                  Aha, thanks for your explanation, things are getting clearer now.

                                  Yes there is a reason for not using the OnFileDownload event:
                                  I installed yet another downloadmanger catching left clicks and it
                                  intercepts before i get an OnFileDownload event. For some reasons i want
                                  both options - my own download manger and the other one (as a default).
                                  If mine is running, it should get the downlods. If not - the other one should
                                  manage downloads. So i have to grab the onclick event to be the first in line.
                                  My own download manager runs as a separate process, so i have to code some
                                  interprocess communication, synchronization and data transfer.

                                  I know how to do this all - excect for the com part of it, which is new to me.
                                  My last missing piece in this puzzle is how to retrieve the current url and the
                                  url of the object clicked at (if any). There is a document and a webrowser object
                                  needed in method onclick as far as i can see. But how to get it ? If i use globals
                                  it works with only one (the first opened) browser window (and there might be more
                                  than one instances running). Using instance variables doesn´t help either, because
                                  these are valid only in the context of their class but here i´m in
                                  "Class_HTMLDocumentEvents" and not in "CDWebBrowserEvents2", where these would be
                                  available.

                                  I thought document.URL and webbrowser.StatusText properties could give me the
                                  information i need. StatusText may not be very elegant, but should do the job.
                                  I don´t know any other way to get the url of the file i want to download. (help
                                  appreciated here)

                                  As i understand it, there is an object hierarchy:
                                  Webrowser -> document -> document events

                                  The IHTMLEventObj interface offers no method to retrieve its "parent" object, which
                                  should be a document object in this case. Is there a generic way to retrieve a
                                  "parent" object from a "child" object like the getparent api does with windows.
                                  Or am i totally wrong here, because things work different in com.

                                  If so - how do they work ?


                                  Guenther

                                  Comment


                                  • #18
                                    I installed yet another downloadmanger catching left clicks and it
                                    intercepts before i get an OnFileDownload event.
                                    I see. I guess the IDownManager interface will not help you here, because
                                    it will be too late by the time you process its Download method.
                                    You might have to parse the HTML of the srcElement.
                                    Dominic Mitchell
                                    Phoenix Visual Designer
                                    http://www.phnxthunder.com

                                    Comment


                                    • #19
                                      Now it works

                                      Dominic,


                                      you posted just as i was writing my last post. Many many thanks!
                                      Your code does the job ! I think now i have enough info to get
                                      along. I don´t need IDownloadManager because this part already
                                      works (i use windows apis here - no com).

                                      IHTMLElement must be retrieved form event object and now i have a
                                      parentElement property to go up the chain ...

                                      Parsing the HTML to get my link is no problem at all!

                                      Why do i get several click events (two, some times three or four),
                                      even if i click only once ? Is this normal behaviour or is it a bug ?


                                      Thanks


                                      Guenther

                                      Comment


                                      • #20
                                        Why do i get several click events (two, some times three or four),
                                        even if i click only once ? Is this normal behaviour or is it a bug ?
                                        This is not a bug. What you are seeing is a behaviour known as bubbling.
                                        I will explain this later, because I have some bad news for you. I thought there was
                                        something odd about the event handlers generated by PB, and now that I have had
                                        another look at those generated by Phoenix for low-level COM, I see what the
                                        difference is. Let me see if I can find a workaround for the PB9 COM version,
                                        because you are in deep trouble(toast).
                                        Dominic Mitchell
                                        Phoenix Visual Designer
                                        http://www.phnxthunder.com

                                        Comment

                                        Working...
                                        X