VB 繼承相關接口實作window.external網頁與程式互動

     在網頁腳本中，window.external可直接傳回程式内嵌式Webbrowser設定的對象執行個體，并可執行該對象的方法，修改對象屬性，對網頁與程式互動提供了便利。

      Webbrowser隻有在實作IDocHostUIHandler接口後， window.external才傳回自定義的對象執行個體，而查遍資料也找不到VB6的實作方法，隻好翻譯了一段C++的代碼。

         使用了olellb.tlb第三方類型庫。引用 olellb.tlb和 olellb2.tlb 。         下面是實作 IDocHostUIHandler接口 的部分代碼，同時實作了攔截Webbrowser的下載下傳事件和URL。  

  Private m_oWebBrowser As SHDocVw.WebBrowser                ' WebBrowser control類型

  Implements olelib.IDocHostUIHandler '繼承 IDocHostUIHandler事件

Implements olelib.IDownloadManager ' 繼承下載下傳事件 Implements olelib2.IServiceProvider ' 繼承 接口相關 Implements olelib.IOleClientSite ' 繼承 接口相關 Private IID_IInternetSecurityManager As olelib.UUID 'IDownloadManager Private IID_IDownloadManager As olelib.UUID 'INewWindowManager Private IID_INewWindowManager As olelib.UUID

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Function init(web As Object)     Call Initialize          Set m_oWebBrowser = web          Dim oOleObj As IOleObject     Dim oOC As IOleControl     Set oOleObj = m_oWebBrowser     oOleObj.SetClientSite Me          Set oOC = oOleObj     oOC.OnAmbientPropertyChange -5513     oOC.OnAmbientPropertyChange -5512          Dim tOle As olelib.IOleWindow     Set tOle = m_oWebBrowser     m_hOleWindow = tOle.GetWindow()

    SetWindowLong m_hOleWindow, (-21&), ObjPtr(m_oWebBrowser)          Set oOleObj = Nothing     Set oOC = Nothing     Set tOle = Nothing      End Function

Private Sub IDownloadManager_Download(ByVal pmk As olelib.IMoniker, ByVal pbc As olelib.IBindCtx, ByVal dwBindVerb As Long, ByVal grfBINDF As Long, pbindinfo As olelib.BINDINFO, ByVal pszHeaders As Long, ByVal pszRedir As Long, ByVal uiCP As Long)     Dim tUrl$     Dim Cancel&     tUrl = olelib.SysAllocString(pmk.GetDisplayName(pbc, Nothing))

    Debug.Print vbTab & vbTab & tUrl '發生下載下傳事件     Cancel = 1 End Sub

  Private Function IOleClientSite_GetContainer() As olelib.IOleContainer    Err.Raise E_NOTIMPL 'Set IOleClientSite_GetContainer = me End Function Private Function IOleClientSite_GetMoniker(ByVal dwAssign As olelib.OLEGETMONIKER, ByVal dwWhichMoniker As olelib.OLEWHICHMK) As olelib.IMoniker    Err.Raise E_NOTIMPL End Function Private Sub IOleClientSite_OnShowWindow(ByVal fShow As olelib.BOOL)    Err.Raise E_NOTIMPL End Sub Private Sub IOleClientSite_RequestNewObjectLayout()    Err.Raise E_NOTIMPL End Sub Private Sub IOleClientSite_ShowObject()    Err.Raise E_NOTIMPL End Sub

Private Sub IServiceProvider_QueryService(guidService As olelib.UUID, _                                           riid As olelib.UUID, _                                           ppvObject As Long)

    Dim tun As olelib.IUnknown

    If olelib.IsEqualGUID(guidService, IID_IInternetSecurityManager) Then         Set tun = Me         tun.QueryInterface IID_IInternetSecurityManager, ppvObject              Else         If IsEqualGUID(guidService, IID_IDownloadManager) And IsEqualGUID(riid, IID_IDownloadManager) Then             Set tun = Me             tun.QueryInterface IID_IDownloadManager, ppvObject                      Else 'If IsEqualGUID(guidService, IID_INewWindowManager) And IsEqualGUID(riid, IID_INewWindowManager) Then             'Else                 Err.Raise E_NOINTERFACE                          End If

    End If     Set tun = Nothing End Sub

Private Sub IOleClientSite_ShowObject()    Err.Raise E_NOTIMPL End Sub Private Sub IDocHostUIHandler_EnableModeless(ByVal fEnable As olelib.BOOL)    Err.Raise E_NOTIMPL End Sub Private Function IDocHostUIHandler_FilterDataObject(ByVal pDO As olelib.IDataObject) As olelib.IDataObject    Err.Raise E_NOTIMPL End Function Private Function IDocHostUIHandler_GetDropTarget(ByVal pDropTarget As olelib.IDropTarget) As olelib.IDropTarget    Set m_o_pDropTarget = pDropTarget     If m_bCusDragDrop Then         Set IDocHostUIHandler_GetDropTarget = Me     Else         Set IDocHostUIHandler_GetDropTarget = m_oWebBrowser     End If

End Function Private Function IDocHostUIHandler_GetExternal() As Object     Set IDocHostUIHandler_GetExternal = Me                                     '{{{{{ 重點  給window.External指派   }}}} End Function Private Sub IDocHostUIHandler_GetHostInfo(pInfo As olelib.DOCHOSTUIINFO)    pInfo.dwFlags = HostInfo    pInfo.dwDoubleClick = DOCHOSTUIDBLCLK_DEFAULT End Sub Private Sub IDocHostUIHandler_GetOptionKeyPath(pOLESTRchKey As Long, ByVal dw As Long)    Err.Raise E_NOTIMPL End Sub Private Sub IDocHostUIHandler_GetOverrideKeyPath(pchKey As Long, ByVal dw As Long)    Err.Raise E_NOTIMPL End Sub Private Sub IDocHostUIHandler_ShowContextMenu( _         ByVal dwContext As olelib.ContextMenuTarget, _         pPOINT As olelib.POINT, _         ByVal pCommandTarget As olelib.IOleCommandTarget, _         ByVal HTMLTagElement As Object)

   Err.Raise E_NOTIMPL End Sub Private Sub IDocHostUIHandler_TranslateAccelerator(lpMsg As olelib.MSG, pguidCmdGroup As olelib.UUID, ByVal nCmdID As Long)     Err.Raise E_NOTIMPL End Sub

Private Sub Initialize()         CLSIDFromString IIDSTR_IInternetSecurityManager, IID_IInternetSecurityManager     'IDownloadManager     CLSIDFromString "{988934A4-064B-11D3-BB80-00104B35E7F9}", IID_IDownloadManager     'INewWindowManager     CLSIDFromString "{D2BC4C84-3F72-4a52-A604-7BCBF3982CBB}", IID_INewWindowManager      End Sub

Private Sub Form_Load()     call init(webbrowser1)  '實作 webbrowser1的 相關接口 End Sub

現在窗體上的webbrowser1已經實作了相關接口，網頁腳本中的 window.external可傳回程式窗體的執行個體。

假設現要在要在網頁中執行VB程式中的showMsg方法：

在上述代碼基礎下添加以下代碼：

Public sub  showMsg(msg as string)    '将被執行的代碼

        msgbox msg

end sub

測試網頁源碼如下：

<html> <input name="checkusername" type="button" value="檢查" style="width:50; height:20;" onClick="j_an('你好')" />

<script language="JavaScript">

function j_an(stext){ window.external.showMsg(stext); } </script>

</html>  

form中的webbrowser1裝載上述網頁，單擊網頁中的“檢查”按鈕，form的 showMsg方法将被執行，實作網頁腳本與VB程式的互動。

此外在網頁腳本中， window.external還可通路form上的任何控件 。

另外，上述代碼還實作了攔截webbrowser的下載下傳事件，及下載下傳URL，對下載下傳操作進行控制等。