VB 获取 Internet Explorer_Server 里面的内容

  1 Option Explicit
  2 '
  3 ' 要求：使用本模块时需要在工程中引用 Microsoft HTML Object Library。
  4 '
  5 Private Type GUID
  6     Data1 As Long
  7     Data2 As Integer
  8     Data3 As Integer
  9     Data4(0 To 7) As Byte
 10 End Type
 11 Private Declare Function GetClassName Lib "user32" _
 12         Alias "GetClassNameA" ( _
 13         ByVal hWND As Long, _
 14         ByVal lpClassName As String, _
 15         ByVal nMaxCount As Long) As Long
 16 Private Declare Function EnumChildWindows Lib "user32" ( _
 17         ByVal hWndParent As Long, _
 18         ByVal lpEnumFunc As Long, _
 19         lParam As Long) As Long
 20 Private Declare Function RegisterWindowMessage Lib "user32" _
 21         Alias "RegisterWindowMessageA" ( _
 22         ByVal lpString As String) As Long
 23 Private Declare Function SendMessageTimeout Lib "user32" _
 24         Alias "SendMessageTimeoutA" ( _
 25         ByVal hWND As Long, _
 26         ByVal msg As Long, _
 27         ByVal wParam As Long, _
 28         lParam As Any, _
 29         ByVal fuFlags As Long, _
 30         ByVal uTimeout As Long, _
 31         lpdwResult As Long) As Long
 32 Private Const SMTO_ABORTIFHUNG = &H2
 33 Private Declare Function ObjectFromLresult Lib "oleacc" ( _
 34         ByVal lResult As Long, _
 35         riid As GUID, _
 36         ByVal wParam As Long, _
 37         ppvObject As Any) As Long
 38 Private Declare Function FindWindow Lib "user32" _
 39         Alias "FindWindowA" ( _
 40         ByVal lpClassName As String, _
 41         ByVal lpWindowName As String) As Long
 42 '
 43 ' 函数：IEDOMFromhWnd。
 44 '
 45 ' 返回：一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
 46 '
 47 ' hWnd 参数：WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
 48 '
 49 Function IEDOMFromhWnd(ByVal hWND As Long) As IHTMLDocument
 50     Dim IID_IHTMLDocument As GUID
 51     Dim hWndChild As Long
 52     Dim lRes As Long
 53     Dim lMsg As Long
 54     Dim hr As Long
 55     If hWND <> 0 Then
 56         If Not IsIEServerWindow(hWND) Then
 57             ' 查找一个 WebBrowser 控件。
 58             EnumChildWindows hWND, AddressOf EnumChildProc, hWND
 59         End If
 60         If hWND <> 0 Then
 61             ' 注册消息。
 62             lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
 63             ' 获取对象的指针。
 64             Call SendMessageTimeout(hWND, lMsg, 0, 0, _
 65                     SMTO_ABORTIFHUNG, 1000, lRes)
 66             If lRes Then
 67                 ' 初始化接口 ID。
 68                 With IID_IHTMLDocument
 69                     .Data1 = &H626FC520
 70                     .Data2 = &HA41E
 71                     .Data3 = &H11CF
 72                     .Data4(0) = &HA7
 73                     .Data4(1) = &H31
 74                     .Data4(2) = &H0
 75                     .Data4(3) = &HA0
 76                     .Data4(4) = &HC9
 77                     .Data4(5) = &H8
 78                     .Data4(6) = &H26
 79                     .Data4(7) = &H37
 80                 End With
 81                 ' 利用指针 lRes 获取 IHTMLDocument 对象。
 82                 hr = ObjectFromLresult(lRes, IID_IHTMLDocument, _
 83                         0, IEDOMFromhWnd)
 84             End If
 85         End If
 86     End If
 87 End Function
 88 Private Function IsIEServerWindow(ByVal hWND As Long) As Boolean
 89     Dim lRes As Long
 90     Dim sClassName As String
 91     ' 初始化缓冲区大小。
 92     sClassName = String$(255, 0)
 93     ' 获取 hWnd 句柄拥有者的类名称。
 94     lRes = GetClassName(hWND, sClassName, Len(sClassName))
 95     sClassName = Left$(sClassName, lRes)
 96     IsIEServerWindow = StrComp(sClassName, _
 97             "Internet Explorer_Server", _
 98             vbTextCompare) = 0
 99 End Function
100 Function EnumChildProc(ByVal hWND As Long, lParam As Long) As Long
101     If IsIEServerWindow(hWND) Then
102         lParam = hWND
103     Else
104         EnumChildProc = 1
105     End If
106 End Function
107 
108 '以下早得到微软UC的聊天记录
109 
110 Option Explicit
111 Private Sub Command1_Click()
112     Dim hWND As Long
113     Dim s As String * 255
114     Dim l As Long
115     hWND = FindWindow("IMWindowClass", vbNullString)
116     GETTEXT hWND
117 End Sub
118 Private Sub GETTEXT(hWND As Long)
119     '创建一个 IHTMLDocument 对象。
120     Dim objIES As New HTMLDocument
121     Set objIES = IEDOMFromhWnd(hWND) 'hWnd 这个东西你肯定有 N 种办法得到。
122     '应用。
123     '例如下面是获得一个 WebBrowser 控件当前浏览网页的地址和该网页的 HTML 源码。
124     Text1.Text = objIES.url & vbCrLf & vbCrLf & objIES.documentElement.innerHTML
125 End Sub