VB 获取 Internet Explorer_Server 里面的内容

VB 获取 Internet Explorer_Server 里面的内容
2009年08月22日
　　　　最近几天，在群里有很多朋友询问如何通过“Internet Explorer_Server”类控件的句柄得到网页内容的问题。今天有时间，在网上搜索了一下，综合多方资料，我写了个模块用以解决上述问题。
　　　　呵呵，请看过的朋友回个贴哦，增加一下我空间的人气。^-^哈哈，不多说了，言归正传，请看代码：
　　'
　　' 模块代码：
　　'
　　Option Explicit'
　　' 要求：使用本模块时需要在工程中引用 Microsoft HTML Object Library。
　　'Private Type GUID
　　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。
　　'
　　' 返回：一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
　　'
　　' hWnd 参数：WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
　　'
　　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
　　' 查找一个 WebBrowser 控件。
　　EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd        End If
　　If hWnd  0 Then
　　' 注册消息。
　　lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")            ' 获取对象的指针。
　　Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
　　SMTO_ABORTIFHUNG, 1000, lRes)            If lRes Then
　　' 初始化接口 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                ' 利用指针 lRes 获取 IHTMLDocument 对象。
　　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    ' 初始化缓冲区大小。
　　sClassName = String$(255, 0)    ' 获取 hWnd 句柄拥有者的类名称。
　　lRes = GetClassName(hWnd, sClassName, Len(sClassName))
　　sClassName = Left$(sClassName, lRes)    IsIEServerWindow = StrComp(sClassName, _
　　"Internet Explorer_Server", _
　　vbTextCompare) = 0End Function
　　Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
　　If IsIEServerWindow(hWnd) Then
　　lParam = hWnd
　　Else
　　EnumChildProc = 1
　　End IfEnd Function
　　'
　　' 举例：
　　'
　　' 使用时先创建一个 IHTMLDocument 对象。
　　'
　　' Dim objIES As New HTMLDocument
　　'
　　' Set objIES = IEDOMFromhWnd(hWnd)
　　'
　　' 这样 objIES 就能使用了。
　　'
　　'
　　' 窗体代码：
　　Option Explicit
　　Private Sub Form_Load()
　　'创建一个 IHTMLDocument 对象。
　　Dim objIES As New HTMLDocument
　　Set objIES = IEDOMFromhWnd(hWnd) 'hWnd 这个东西你肯定有 N 种办法得到。    '应用。
　　'例如下面是获得一个 WebBrowser 控件当前浏览网页的地址和该网页的 HTML 源码。
　　Text1.Text = objIES.url & vbCrLf & vbCrLf & objIES.documentElement.innerHTML
　　End Sub