七、一个完善的程序
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 教程 目录