现在的位置: 首页 > 综合 > 正文

VB 获取 Internet Explorer_Server 里面的内容

2012年08月01日 ⁄ 综合 ⁄ 共 4344字 ⁄ 字号 评论关闭

  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 7As 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 LongAs Long
 16 Private Declare Function EnumChildWindows Lib "user32" ( _
 17         ByVal hWndParent As Long, _
 18         ByVal lpEnumFunc As Long, _
 19         lParam As LongAs Long
 20 Private Declare Function RegisterWindowMessage Lib "user32" _
 21         Alias "RegisterWindowMessageA" ( _
 22         ByVal lpString As StringAs 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 LongAs 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 StringAs Long
 42 '
 43 ' 函数:IEDOMFromhWnd。
 44 '
 45 ' 返回:一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
 46 '
 47 ' hWnd 参数:WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
 48 '
 49 Function IEDOMFromhWnd(ByVal hWND As LongAs 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, 00, _
 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 LongAs Boolean
 89     Dim lRes As Long
 90     Dim sClassName As String
 91     ' 初始化缓冲区大小。
 92     sClassName = String$(2550)
 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 LongAs 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

抱歉!评论已关闭.