vb.net 教程 20-3 控制Ie浏览器 8

前端之家收集整理的这篇文章主要介绍了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

运行结果:


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

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

原文链接:https://www.f2er.com/vb/256391.html

猜你在找的VB相关文章