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,_
    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,_
            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