VB 获取 Internet Explorer_Server 里面的内容
2009年08月22日
最近几天,在群里有很多朋友询问如何通过“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 UUID, _
ByVal wParam As Long, _
ppvObject As Any) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long'
' 函数:IEDOMFromhWnd。
'
' 返回:一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
'
' hWnd 参数:WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
'
Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
Dim IID_IHTMLDocument As UUID
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) = 0End Function
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
If IsIEServerWindow(hWnd) Then
lParam = hWnd
Else
EnumChildProc = 1
End IfEnd Function
'
' 举例:
'
' 使用时先创建一个 IHTMLDocument 对象。
'
' Dim objIES As New HTMLDocument
'
' Set objIES = IEDOMFromhWnd(hWnd)
'
' 这样 objIES 就能使用了。
'
'
' 窗体代码:
Option Explicit
Private Sub Form_Load()
'创建一个 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
2009年08月22日
最近几天,在群里有很多朋友询问如何通过“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 UUID, _
ByVal wParam As Long, _
ppvObject As Any) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long'
' 函数:IEDOMFromhWnd。
'
' 返回:一个 WebBrowser 窗口的 IHTMLDocument 对象接口。
'
' hWnd 参数:WebBrowser 控件的句柄或 WebBrowser 控件所在窗口的句柄。
'
Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
Dim IID_IHTMLDocument As UUID
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) = 0End Function
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
If IsIEServerWindow(hWnd) Then
lParam = hWnd
Else
EnumChildProc = 1
End IfEnd Function
'
' 举例:
'
' 使用时先创建一个 IHTMLDocument 对象。
'
' Dim objIES As New HTMLDocument
'
' Set objIES = IEDOMFromhWnd(hWnd)
'
' 这样 objIES 就能使用了。
'
'
' 窗体代码:
Option Explicit
Private Sub Form_Load()
'创建一个 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