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,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,"TabWindowClass",Nothing)
                If TWCHwnd = 0 Then
                    Continue For
                End If
                'shell DocObject View
                Dim SDVHwnd As Integer
                SDVHwnd = FindWindowEx(TWCHwnd,"shell DocObject View",Nothing)
                If SDVHwnd = 0 Then
                    Continue For
                End If
                'Internet Explorer_Server
                Dim IESHwnd As Integer
                IESHwnd = FindWindowEx(SDVHwnd,"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),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),result,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,Nothing)
            Do While result <> 0
                IEHwndArray.Add(result)
                '获得下一个IE窗口，直到返回0
                result = FindWindowEx(0,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,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,I_IEdocument) = 0 Then
            Return I_IEdocument
        End If
        Return Nothing
    End Function

End Class

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!