SHDocVw.ShellWindows可以返回windows窗口数目

引用Microsoft Internet Controls对象

在工程中引用Microsoft Internet Controls对象，然后加入以下代码：

Dim WebCount As SHDocVwCtl.ShellWindows

Set WebCount = New SHDocVwCtl.ShellWindows

MsgBox "已经打开" & WebCount.Count & "个网页"

执行后能得到Microsoft Internet Explorer 和 Maxthon(遨游，原名：MyIE2)浏览器打开的网页个数，但怎样获取这些打开的网页的标题和地址呢？我希望得到这些信息：

ShellWindows 用法及相关

<p>ShellWindows 用法及相关</p>

<p>1/如何使用ShellExecute在新的窗口中打开新的网站</p>

<p>打开VB菜单的 Project|References 项，在References对话框中有一个Microsoft Internet Control项，选中它，然后在Form1中加入一个CommandButton，在Form1中加入一下代码：<br />

'Dim dWinFolder As ShellLinkObject<br />

Dim dWinFolder As ShellWindows</p>

<p>Private Sub Command1_Click()<br />

bBrowser = False<br />

If dWinFolder.Count = 0 Then<br />

'没有打开的浏览器窗口，执行常规的ShellExecute 打开网页<br />

Else<br />

dWinFolder.Item(0).Navigate "file:///c:/windows/temp/a.htm", navOpenInNewWindow, _<br />

"_blank", 0, 0<br />

End If<br />

End Sub</p>

<p>Private Sub Form_Load()<br />

Set dWinFolder = New ShellWindows<br />

End Sub</p>

<p>Private Sub Form_Unload(Cancel As Integer)<br />

Set dWinFolder = Nothing<br />

End Sub<br />

运行程序，就可以在新窗口中打开了。ShellWindows对象是Windows下运行的所有外壳浏览器的集合。</p>

<p>2/如何在打开IE的时候自动启动其他程序，在关闭IE的时候一同关闭<br />

1、工程中引用 Microsoft Internet Controls<br />

2、在Form1中添加一个ListBox控件<br />

3、在Form1中添加如下代码：</p>

<p>Dim WithEvents dWinFolder As ShellWindows<br />

Dim objIE As Object</p>

<p>Private Sub dWinFolder_WindowRegistered(ByVal lCookie As Long)<br />

On Error Resume Next<br />

For Each objIE In dWinFolder<br />

List1.AddItem objIE.Document.Title<br />

Next<br />

End Sub</p>

<p>Private Sub dWinFolder_WindowRevoked(ByVal lCookie As Long)<br />

If dWinFolder.Count = 0 Then End<br />

End Sub</p>

<p>Private Sub Form_Load()<br />

Set dWinFolder = New ShellWindows<br />

End Sub</p>

<p>在一个IE窗口创建时会引发 dWinFolder_WindowRegistered事件，在关闭一个窗口时会引发dWinFolder_WindowRevoked事件</p>

<p>3/用VB自动关闭网页广告窗口</p>

<p> 网页广告分析：</p>

<p> 1.弹出的广告窗口<br />

网页中弹出的广告窗口都是用JS或VBS编写的脚本程序，每个广告窗口都有自已的URL地址，只要获取所有的IE窗口的URL地址，再把其中的广告窗口的URL地址记录下来保存到文本文件中，并且关闭这个窗口，就达到了自动关闭广告的目的。<br />

2.Flash广告窗口<br />

有些广告是FLASH动画，只要获得窗口句柄，关闭类名为“MacromediaFlashPlayerActiveX”的FLASH播放控件，就可以关闭这些FLASH广告了。<br />

编程原理：通过设置定时器定时搜索，根据IE的程序名判断是否有IE窗口打开，如发现再进一步判断打开的IE的URL的地址是否与记录在列表框中的一致，如相同就关闭它。由于不涉及窗口的类名，无论是IE的各个版本都可以使用。至于网页中的FLASH则是通过“FindWindowEx”函数来一层层的查找打开网页窗口的“MacromediaFlashPlayerActiveX”类名（IE窗口的各个类名是通过工具软件“SPY++”可以获得），并返回窗口句柄，再用“SendMessage”消息函数发送消息关Flash广告窗口。</p>

<p> 程序设计：</p>

<p> 新建一个工程，添加一个窗体和控件。<br />

1.建立一个用来控制图标在系统托盘的模块“Module1”，相关代码见后文下载地址。<br />

2.程序主窗口的部分代码如下：<br />

Private Sub cmdRightOne_Click()'向黑名单列表中添加网址，cmdLeftOne的代码与此雷同，详见程序源代码<br />

On Error Resume Next<br />

Dim i As Integer<br />

If lstAll.ListCount = 0 Then Exit Sub<br />

If lstAll.Text = "" Then Exit Sub<br />

lstSelected.AddItem lstAll.Text<br />

i = lstAll.ListIndex<br />

lstAll.RemoveItem lstAll.ListIndex<br />

If lstAll.ListCount &gt; 0 Then<br />

If i &gt; lstAll.ListCount - 1 Then<br />

lstAll.ListIndex = i - 1<br />

Else<br />

lstAll.ListIndex = i<br />

End If<br />

End If<br />

lstSelected.ListIndex = lstSelected.NewIndex<br />

End Sub</p>

<p> Private Sub closeflash()'关闭flash动画<br />

On Error GoTo callerrora<br />

Dim sclassname As String<br />

Dim windowhandle As Long<br />

Dim lhwnd As Long<br />

Dim a As Long<br />

lhwnd = 0<br />

sclassname = ("IEFrame")<br />

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)<br />

sclassname = ("Shell DocObject View")<br />

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)<br />

sclassname = ("Internet Explorer_server")<br />

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)<br />

sclassname = ("MacromediaFlashPlayerActiveX")<br />

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)<br />

windowhandle = lhwnd<br />

If windowhandle &lt;&gt; 0 Then<br />

a = SendMessage(windowhandle, WM_CLOSE, 0, 0)<br />

End If<br />

Exit Sub<br />

callerrora:<br />

MsgBox Err.Description<br />

Err.Clear<br />

End Sub</p>

<p> Private Sub filter()'过滤黑名单中的广告链接<br />

Dim objIE As Object<br />

Dim i As Integer<br />

On Error Resume Next<br />

For Each objIE In dWinFolder '遍历所有IE浏览器窗口<br />

If InStr(1, objIE.FullName, "IEXPLORE.EXE", vbTextCompare) &lt;&gt; 0 Then<br />

For i = 1 To lstSelected.ListCount - 1<br />

If objIE.LocationURL = Trim(lstSelected.List(i)) Then<br />

objIE.Quit<br />

Exit For<br />

End If<br />

Next i<br />

End If<br />

Next<br />

objIE = Nothing<br />

End Sub<br />

代码输入完毕，按F5运行一下吧（如图）！然后在IE中打开一个含有多个广告窗口的网页看一下效果如何，只要单击托盘图标调出程序，按“刷新”按钮就会在左边栏中列出所有的URL地址，把广告窗口的URL地址添加到右边的黑名单中，“确定”后以后就会自动关闭这个广告窗口了。如果想浏览它，再把它从黑名单中删除即可。也可以在托盘图标的右键菜单中，控制功能的开/关。</p>

<p>4/怎样编程得到当前Web窗口文本信息</p>

<p>Dim dWinFolder As New ShellWindows<br />

Dim WithEvents eventIE As WebBrowser_V1</p>

<p>Private Sub Command1_Click()<br />

Dim objIE As Object<br />

<br />

For Each objIE In dWinFolder<br />

If objIE.LocationURL = List1.List(List1.ListIndex) Then<br />

Set eventIE = objIE<br />

Command1.Enabled = False<br />

List1.Enabled = False<br />

Text1.Text = ""<br />

Exit For<br />

End If<br />

Next<br />

End Sub</p>

<p>Private Sub eventIE_NavigateComplete(ByVal URL As String)<br />

Text1.Text = Text1.Text + Chr(13) + Chr(10) + URL<br />

End Sub</p>

<p>在运行前。点击菜单 Projects | References 项，在Available References 列表中选择Microsoft Internet Controls项将Internet对象引用介入到工程中</p>

<p>Private Sub Form_Load()<br />

Dim objIE As Object<br />

<br />

For Each objIE In dWinFolder<br />

If InStr(1, objIE.FullName, "IEXPLORE.EXE", vbTextCompare) &lt;&gt; 0 Then<br />

List1.AddItem objIE.LocationURL<br />

End If<br />

Next<br />

Command1.Caption = "正文"<br />

End Sub</p>

<p>Private Sub Form_Unload(Cancel As Integer)<br />

Set dWinFolder = Nothing<br />

End Sub</p>

<p>Private Sub List1_Click()<br />

Dim objDoc As Object<br />

Dim objIE As Object<br />

<br />

For Each objIE In dWinFolder<br />

If objIE.LocationURL = List1.List(List1.ListIndex) Then<br />

Set objDoc = objIE.Document<br />

<br />

For i = 1 To objDoc.All.length - 1<br />

If objDoc.All(i).tagname = "BODY" Then<br />

Text1.Text = objDoc.All(i).innerText<br />

End If<br />

Next<br />

Exit For<br />

End If<br />

Next<br />

End Sub</p>