http://blog.csdn.net/rztyfx/article/details/9499421
模块中的代码:
- 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