版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。
七、一个完善的程序
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 教程 目录
————————————————
版权声明：本文为CSDN博主「VB.Net」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。
