How to get the DOM of a WebBrowser control from a window handle (VB6)

How to get the DOM of a WebBrowser control from a window handle (VB6)
http://www.mvps.org/emorcillo/en/code/vb6/iedom.shtml

The following code is the VB version of the C code in the KB article 249232 - HOWTO: Get IHTMLDocument2 from a HWND. It requires oleacc.dll to be installed on the system (oleacc.dll is part of the Active Accessibility).

'
' Requires: reference to "Microsoft HTML Object Library"
'

Private Type UUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Declare Function GetClassName Lib "user32" _
   Alias "GetClassNameA" ( _
   ByVal hWnd As Long, _
   ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long

Private Declare Function EnumChildWindows Lib "user32" ( _
   ByVal hWndParent As Long, _
   ByVal lpEnumFunc As Long, _
   lParam As Long) As Long

Private Declare Function RegisterWindowMessage Lib "user32" _
   Alias "RegisterWindowMessageA" ( _
   ByVal lpString As String) As Long

Private Declare Function SendMessageTimeout Lib "user32" _
   Alias "SendMessageTimeoutA" ( _
   ByVal hWnd As Long, _
   ByVal msg As Long, _
   ByVal wParam As Long, _
   lParam As Any, _
   ByVal fuFlags As Long, _
   ByVal uTimeout As Long, _
   lpdwResult As Long) As Long
      
Private Const SMTO_ABORTIFHUNG = &H2

Private Declare Function ObjectFromLresult Lib "oleacc" ( _
   ByVal lResult As Long, _
   riid As UUID, _
   ByVal wParam As Long, _
   ppvObject As Any) As Long

Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

'
' IEDOMFromhWnd
'
' Returns the IHTMLDocument interface from a WebBrowser window
'
' hWnd - Window handle of the control
'
Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
Dim IID_IHTMLDocument As UUID
Dim hWndChild As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long

   If hWnd <> 0 Then
      
      If Not IsIEServerWindow(hWnd) Then
      
         ' Find a child IE server window
         EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd
         
      End If
      
      If hWnd <> 0 Then
            
         ' Register the message
         lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
            
         ' Get the object pointer
         Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
                 SMTO_ABORTIFHUNG, 1000, lRes)

         If lRes Then
               
            ' Initialize the interface ID
            With IID_IHTMLDocument
               .Data1 = &H626FC520
               .Data2 = &HA41E
               .Data3 = &H11CF
               .Data4(0) = &HA7
               .Data4(1) = &H31
               .Data4(2) = &H0
               .Data4(3) = &HA0
               .Data4(4) = &HC9
               .Data4(5) = &H8
               .Data4(6) = &H26
               .Data4(7) = &H37
            End With
               
            ' Get the object from lRes
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument,_
                     0, IEDOMFromhWnd)
               
         End If

      End If
      
   End If

End Function

Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
Dim lRes As Long
Dim sClassName As String

   ' Initialize the buffer
   sClassName = String$(100, 0)
   
   ' Get the window class name
   lRes = GetClassName(hWnd, sClassName, Len(sClassName))
   sClassName = Left$(sClassName, lRes)
   
   IsIEServerWindow = StrComp(sClassName, _
                      "Internet Explorer_Server", _
                      vbTextCompare) = 0
   
End Function

'
' Copy this function to a .bas module
'
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
   
   If IsIEServerWindow(hWnd) Then
      lParam = hWnd
   Else
      EnumChildProc = 1
   End If
   
End Function
1、资源项目源码均已通过严格测试验证,保证能够正常运行; 2、项目问题、技术讨论,可以给博主私信或留言,博主看到后会第一时间与您进行沟通; 3、本项目比较适合计算机领域相关的毕业设计课题、课程作业等使用,尤其对于人工智能、计算机科学与技术等相关专业,更为适合; 4、下载使用后,可先查看REaDME.md或论文文件(如有),本项目仅用作交流学习参考,请切勿用于商业用途。 5、资源来自互联网采集,如有侵权,私聊博主删除。 6、可私信博主看论文后选择购买源代码。 1、资源项目源码均已通过严格测试验证,保证能够正常运行; 2、项目问题、技术讨论,可以给博主私信或留言,博主看到后会第一时间与您进行沟通; 3、本项目比较适合计算机领域相关的毕业设计课题、课程作业等使用,尤其对于人工智能、计算机科学与技术等相关专业,更为适合; 4、下载使用后,可先查看README.md或论文文件(如有),本项目仅用作交流学习参考,请切勿用于商业用途。 5、资源来自互联网采集,如有侵权,私聊博主删除。 6、可私信博主看论文后选择购买源代码。 1、资源项目源码均已通过严格测试验证,保证能够正常运行; 2、项目问题、技术讨论,可以给博主私信或留言,博主看到后会第一时间与您进行沟通; 3、本项目比较适合计算机领域相关的毕业设计课题、课程作业等使用,尤其对于人工智能、计算机科学与技术等相关专业,更为适合; 4、下载使用后,可先查看README.md或论文文件(如有),本项目仅用作交流学习参考,请切勿用于商业用途。 5、资源来自互联网采集,如有侵权,私聊博主删除。 6、可私信博主看论文后选择购买源代码。
1、资源项目源码均已通过严格测试验证,保证能够正常运行; 2、项目问题、技术讨论,可以给博主私信或留言,博主看到后会第一时间与您进行沟通; 3、本项目比较适合计算机领域相关的毕业设计课题、课程作业等使用,尤其对于人工智能、计算机科学与技术等相关专业,更为适合; 4、下载使用后,可先查看README.md或论文文件(如有),本项目仅用作交流学习参考,请切勿用于商业用途。 5、资源来自互联网采集,如有侵权,私聊博主删除。 6、可私信博主看论文后选择购买源代码。 1、资源项目源码均已通过严格测试验证,保证能够正常运行; 2、项目问题、技术讨论,可以给博主私信或留言,博主看到后会第一时间与您进行沟通; 3、本项目比较适合计算机领域相关的毕业设计课题、课程作业等使用,尤其对于人工智能、计算机科学与技术等相关专业,更为适合; 4、下载使用后,可先查看README.md或论文文件(如有),本项目仅用作交流学习参考,请切勿用于商业用途。 5、资源来自互联网采集,如有侵权,私聊博主删除。 6、可私信博主看论文后选择购买源代码。 、资源1项目源码均已通过严格测试验证,保证能够正常运行; 2、项目问题、技术讨论,可以给博主私信或留言,博主看到后会第一时间与您进行沟通; 3、本项目比较适合计算机领域相关的毕业设计课题、课程作业等使用,尤其对于人工智能、计算机科学与技术等相关专业,更为适合; 4、下载使用后,可先查看README.md或论文文件(如有),本项目仅用作交流学习参考,请切勿用于商业用途。 5、资源来自互联网采集,如有侵权,私聊博主删除。 6、可私信博主看论文后选择购买源代码。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值