ShellWindows
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 > 0 Then<br />
If i > 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 <> 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) <> 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) <> 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>