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