VB 获取 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 GUID, _
    ByVal wParam As Long, _
    ppvObject As Any) As Long
Public Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
'
' 函数：IEDOMFromhWnd。
'
' 返回：一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
'
' hWnd 参数：WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
'
Public Function IEDOMFromhWnd(ByVal hWND As Long) As IHTMLDocument
    Dim IID_IHTMLDocument As GUID
    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) = 0
End Function
Function EnumChildProc(ByVal hWND As Long, lParam As Long) As Long
    If IsIEServerWindow(hWND) Then
        lParam = hWND
    Else
        EnumChildProc = 1
    End If
End Function

窗体中的代码:

Option Explicit
Private Sub Command1_Click()
    Dim hWND As Long
    Dim s As String * 255
    Dim l As Long
    hWND = FindWindow("IMWindowClass", vbNullString)
    GETTEXT hWND
End Sub
Private Sub GETTEXT(hWND As Long)
    '创建一个 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