模块中的代码:
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,_ 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,_ 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