vb.net 教程 20-3 控制Ie浏览器 8 一个完善的程序

版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。

七、一个完善的程序

 

Public Class FormMain
    Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (
        ByVal hwndParent As Integer,
        ByVal hwndChildAfter As Integer,
        ByVal lpszClass As String,
        ByVal lpszWindow As String) As Integer

    Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (
        ByVal lpString As String) As Integer

    Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (
        ByVal hWND As Integer,
        ByVal msg As Integer,
        ByVal wParam As Integer,
        ByRef lParam As Integer,
        ByVal fuFlags As Integer,
        ByVal uTimeout As Integer,
        ByRef lpdwResult As Integer) As Integer
    Private Const WM_PAINT = &HF
    Private Const WM_SIZE = &H5
    Private Const SIZE_RESTORED = 0
    Private Const SMTO_ABORTIFHUNG = &H2
    Private Const SMTO_NOTIMEOUTIFNOTHUNG = &H8

    Private Declare Function ObjectFromLresult Lib "oleacc" (
        ByVal lResult As Integer,
        ByRef riid As Guid,
        ByVal wParam As Integer,
        ByRef ppvObject As mshtml.IHTMLDocument2) As Integer

    Private Structure IEWindowHwnd
        Dim IEhwnd As Integer   'IE窗口句柄
        Dim FTabhwnd As Integer 'Frame Tab的窗口句柄
        Dim Ie_SHwnd As Integer '对应IE_Server的窗口句柄
    End Structure

    Public Structure IeDocStructure
        Dim IEhwnd As Integer   'IE窗口句柄
        Dim FTabhwnd As Integer 'Frame Tab的窗口句柄
        Dim IE_SHwnd As Integer '对应IE_Server的窗口句柄
        Dim title As String     'Document title
        Dim url As String       '网址
    End Structure

    Private Sub cbListIE_Click(sender As Object, e As EventArgs) Handles cbListIE.Click
        Dim listIe As New ArrayList
        listIe = getIhtmlDoc()
        If listIe.Count > 0 Then
            For i As Integer = 0 To listIe.Count - 1
                Dim subList As New ListViewItem()
                subList.Text = i.ToString
                Dim iedocInfo As New IeDocStructure
                iedocInfo = CType(listIe.Item(i), IeDocStructure)
                subList.SubItems.Add(iedocInfo.title)
                subList.SubItems.Add(iedocInfo.url)
                lvListIE.Items.Add(subList)
            Next
        End If
    End Sub


    ''' <summary>
    ''' 获得所有打开IE的 mshtml.IHTMLDocument2
    ''' </summary>
    ''' <returns>返回所有mshtml.IHTMLDocument2 ArrayList</returns>
    ''' <remarks></remarks>
    Public Function getIhtmlDoc() As ArrayList
        Dim IEDocArray As New ArrayList
        Dim IEDocInfo As IeDocStructure

        '获得IEWindowHwnd结构的ArrayList
        Dim IESArray As New ArrayList
        IESArray = getIEServer()
        If IESArray.Count = 0 Then Return IESArray
        '循环获得返回的IEWindowHwnd结构
        For i As Integer = 0 To IESArray.Count - 1
            Dim IESHwnd As IEWindowHwnd = CType(IESArray(i), IEWindowHwnd)
            '记录IE窗口的Hwnd
            IEDocInfo.IEhwnd = IESHwnd.IEhwnd
            '记录Frame Tab 窗口的Hwnd
            IEDocInfo.FTabhwnd = IESHwnd.FTabhwnd
            '记录Internet Explorer_Server窗口的Hwnd
            IEDocInfo.IE_SHwnd = IESHwnd.Ie_SHwnd

            '获得IHTMLDocument2接口
            Dim IEdoc As mshtml.IHTMLDocument2
            IEdoc = getDocumentfromIES(IESHwnd.Ie_SHwnd)
            If IEdoc Is Nothing Then

            Else
                '当前的Url
                IEDocInfo.url = IEdoc.url
                '当前IE网页文档的标题
                IEDocInfo.title = IEdoc.title
                Select Case IEdoc.url
                    Case "about:blank"  '如果无标题，且网址为about:blank
                        IEDocInfo.title = "about:blank"
                    Case "about:tabs"   '如果无标题，且网址为about:tabs
                        IEDocInfo.title = "about:tabs"
                    Case Else
                        If IEdoc.title = "" Then
                            IEDocInfo.title = IEdoc.url
                        End If
                        IEDocArray.Add(IEDocInfo)
                End Select

            End If
        Next
        '返回IeDocStructure结构的ArrayList
        Return IEDocArray
    End Function

    ''' <summary>
    ''' 获得IE的Internet Explorer_Server
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function getIEServer() As ArrayList
        Dim IEServerArray As New ArrayList

        Dim IEServerHwnd As IEWindowHwnd
        '获得所有的FrameTab句柄
        Dim IEFrameTabHwndArray As New ArrayList
        IEFrameTabHwndArray = getIEFrameTab()
        '如果FrameTab数量为0，那么就立即返回空IEServerArray
        If IEFrameTabHwndArray.Count = 0 Then Return IEServerArray

        '循环FrameTab最终获得Internet Explorer_Server 句柄
        For i As Integer = 0 To IEFrameTabHwndArray.Count - 1
            Try
                'TabWindowClass
                Dim TWCHwnd As Integer
                TWCHwnd = FindWindowEx(CType(IEFrameTabHwndArray(i), IEWindowHwnd).FTabhwnd, 0, "TabWindowClass", Nothing)
                If TWCHwnd = 0 Then
                    Continue For
                End If
                'shell DocObject View
                Dim SDVHwnd As Integer
                SDVHwnd = FindWindowEx(TWCHwnd, 0, "shell DocObject View", Nothing)
                If SDVHwnd = 0 Then
                    Continue For
                End If
                'Internet Explorer_Server
                Dim IESHwnd As Integer
                IESHwnd = FindWindowEx(SDVHwnd, 0, "Internet Explorer_Server", Nothing)
                If IESHwnd <> 0 Then
                    '记录IE窗口的Hwnd,一直传递下去
                    IEServerHwnd.IEhwnd = CType(IEFrameTabHwndArray(i), IEWindowHwnd).IEhwnd
                    '记录Internet Explorer_Server窗口的Hwnd
                    IEServerHwnd.Ie_SHwnd = IESHwnd
                    IEServerHwnd.FTabhwnd = CType(IEFrameTabHwndArray(i), IEWindowHwnd).FTabhwnd
                    IEServerArray.Add(IEServerHwnd)
                End If

            Catch ex As Exception
                Continue For
            End Try
        Next

        Return IEServerArray
    End Function

    ''' <summary>
    ''' 获得指定IE窗口中的"Frame Tab",可能存在多个
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function getIEFrameTab() As ArrayList
        Dim IEFrameTabHwndArray As New ArrayList

        Dim IEframeTabHwnd As IEWindowHwnd

        '获得所有的IEFrame句柄
        Dim IEHwndArray As New ArrayList
        IEHwndArray = findAllIe()
        '如果IEFrame数量为0，那么就立即返回空IEFrameTabHwndArray
        If IEHwndArray.Count = 0 Then Return IEFrameTabHwndArray

        Dim result As Integer
        '需要查找类名"FrameTab"
        Dim ieClass As String = "Frame Tab"
        '循环获得FrameTab Hwnd
        For i As Integer = 0 To IEHwndArray.Count - 1
            Try
                '从IEFrame句柄获得它下面的第一个FrameTab句柄
                result = FindWindowEx(CType(IEHwndArray(i), Integer), 0, ieClass, Nothing)
                Do While result <> 0
                    '记录IE窗口的Hwnd,一直传递下去
                    IEframeTabHwnd.IEhwnd = CType(IEHwndArray(i), Integer)
                    '记录当前FrameTab窗口的Hwnd,一直传递下去
                    IEframeTabHwnd.FTabhwnd = result
                    '用于记录IE_Server的窗口句柄
                    IEframeTabHwnd.Ie_SHwnd = 0

                    IEFrameTabHwndArray.Add(IEframeTabHwnd)
                    '从IEFrame句柄获得它下面的下一个FrameTab句柄，直到返回0
                    result = FindWindowEx(CType(IEHwndArray(i), Integer), result, ieClass, Nothing)
                Loop
            Catch ex As Exception
                Continue For
            End Try
        Next
        Return IEFrameTabHwndArray
    End Function

    ''' <summary>
    ''' 获得所有的IE窗口hwnd
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function findAllIe() As ArrayList
        Dim IEHwndArray As New ArrayList

        Dim result As Integer
        '需要查找类名 IEFrame
        Dim ieClass As String = "IEFrame"
        Try
            '获得第一个打开的IE窗口
            result = FindWindowEx(0, 0, ieClass, Nothing)
            Do While result <> 0
                IEHwndArray.Add(result)
                '获得下一个IE窗口，直到返回0
                result = FindWindowEx(0, result, ieClass, Nothing)
            Loop
        Catch ex As Exception
            Return IEHwndArray
        End Try
        Return IEHwndArray
    End Function

    ''' <summary>
    ''' 从Internet Explorer_Server获得IHTMLDocument2对象
    ''' </summary>
    ''' <param name="IEShwnd">Internet Explorer_Server 句柄</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    ''' 
    Public Function getDocumentfromIES(ByVal IEShwnd As Integer) As mshtml.IHTMLDocument2
        Dim WM_Html_GETOBJECT As Integer
        WM_Html_GETOBJECT = RegisterWindowMessage("WM_HTML_GETOBJECT")
        Dim tempInt As Integer = 0
        SendMessageTimeout(IEShwnd, WM_Html_GETOBJECT, 0, 0, SMTO_ABORTIFHUNG, 1000, tempInt)

        Dim GUID_IHTMLDocument As New Guid("{626FC520-A41E-11CF-A731-00A0C9082637}")

        Dim I_IEdocument As mshtml.IHTMLDocument2
        If ObjectFromLresult(tempInt, GUID_IHTMLDocument, 0, I_IEdocument) = 0 Then
            Return I_IEdocument
        End If
        Return Nothing
    End Function

End Class

 

运行结果：

 

 

由于.net平台下C#和vb.NET很相似，本文也可以为C#爱好者提供参考。

学习更多vb.net知识，请参看vb.net 教程 目录