ShellWindows

引用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 用法及相关

ShellWindows 用法及相关

1/如何使用ShellExecute在新的视窗中打开新的网站

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

'Dim dWinFolder As ShellLinkObject

Dim dWinFolder As ShellWindows

Private Sub Command1_Click()

bBrowser = False

If dWinFolder.Count = 0 Then

'没有打开的浏览器视窗，执行常规的ShellExecute 打开网页

Else

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

"_blank", 0, 0

End If

End Sub

Private Sub Form_Load()

Set dWinFolder = New ShellWindows

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set dWinFolder = Nothing

End Sub

运行程式，就可以在新视窗中打开了。ShellWindows对象是Windows下运行的所有外壳浏览器的集合。

2/如何在打开IE的时候自动启动其他程式，在关闭IE的时候一同关闭

1、工程中引用 Microsoft Internet Controls

2、在Form1中添加一个ListBox控制项

3、在Form1中添加如下代码：

Dim WithEvents dWinFolder As ShellWindows

Dim objIE As Object

Private Sub dWinFolder_WindowRegistered(ByVal lCookie As Long)

On Error Resume Next

For Each objIE In dWinFolder

List1.AddItem objIE.Document.Title

Next

End Sub

Private Sub dWinFolder_WindowRevoked(ByVal lCookie As Long)

If dWinFolder.Count = 0 Then End

End Sub

Private Sub Form_Load()

Set dWinFolder = New ShellWindows

End Sub

在一个IE视窗创建时会引发 dWinFolder_WindowRegistered事件，在关闭一个视窗时会引发dWinFolder_WindowRevoked事件

3/用VB自动关闭网页广告视窗

网页广告分析：

1.弹出的广告视窗

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

2.Flash广告视窗

有些广告是FLASH动画，只要获得视窗句柄，关闭类名为“MacromediaFlashPlayerActiveX”的FLASH播放控制项，就可以关闭这些FLASH广告了。

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

程式设计：

新建一个工程，添加一个窗体和控制项。

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

2.程式主视窗的部分代码如下：

Private Sub cmdRightOne_Click()'向黑名单列表中添加网址，cmdLeftOne的代码与此雷同，详见程式原始码

On Error Resume Next

Dim i As Integer

If lstAll.ListCount = 0 Then Exit Sub

If lstAll.Text = "" Then Exit Sub

lstSelected.AddItem lstAll.Text

i = lstAll.ListIndex

lstAll.RemoveItem lstAll.ListIndex

If lstAll.ListCount > 0 Then

If i > lstAll.ListCount - 1 Then

lstAll.ListIndex = i - 1

Else

lstAll.ListIndex = i

End If

lstSelected.ListIndex = lstSelected.NewIndex

End Sub

Private Sub closeflash()'关闭flash动画

On Error GoTo callerrora

Dim sclassname As String

Dim windowhandle As Long

Dim lhwnd As Long

Dim a As Long

lhwnd = 0

sclassname = ("IEFrame")

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)

sclassname = ("Shell DocObject View")

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)

sclassname = ("Internet Explorer_server")

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)

sclassname = ("MacromediaFlashPlayerActiveX")

lhwnd = FindWindowEx(lhwnd, 0, sclassname, vbNullString)

windowhandle = lhwnd

If windowhandle <> 0 Then

a = SendMessage(windowhandle, WM_CLOSE, 0, 0)

End If

Exit Sub

callerrora:

MsgBox Err.Description

Err.Clear

End Sub

Private Sub filter()'过滤黑名单中的广告连结

Dim objIE As Object

Dim i As Integer

On Error Resume Next

For Each objIE In dWinFolder '遍历所有IE浏览器视窗

If InStr(1, objIE.FullName, "IEXPLORE.EXE", vbTextCompare) <> 0 Then

For i = 1 To lstSelected.ListCount - 1

If objIE.LocationURL = Trim(lstSelected.List(i)) Then

objIE.Quit

Exit For

End If

Next i

End If

Next

objIE = Nothing

End Sub

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

4/怎样编程得到当前Web视窗文本信息

Dim dWinFolder As New ShellWindows

Dim WithEvents eventIE As WebBrowser_V1

Private Sub Command1_Click()

Dim objIE As Object

For Each objIE In dWinFolder

If objIE.LocationURL = List1.List(List1.ListIndex) Then

Set eventIE = objIE

Command1.Enabled = False

List1.Enabled = False

Text1.Text = ""

Exit For

End If

Next

End Sub

Private Sub eventIE_NavigateComplete(ByVal URL As String)

Text1.Text = Text1.Text + Chr(13) + Chr(10) + URL

End Sub

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

Private Sub Form_Load()

Dim objIE As Object

For Each objIE In dWinFolder

If InStr(1, objIE.FullName, "IEXPLORE.EXE", vbTextCompare) <> 0 Then

List1.AddItem objIE.LocationURL

End If

Next

Command1.Caption = "正文"

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set dWinFolder = Nothing

End Sub

Private Sub List1_Click()

Dim objDoc As Object

Dim objIE As Object

For Each objIE In dWinFolder

If objIE.LocationURL = List1.List(List1.ListIndex) Then

Set objDoc = objIE.Document

For i = 1 To objDoc.All.length - 1

If objDoc.All(i).tagname = "BODY" Then

Text1.Text = objDoc.All(i).innerText

End If

Next

Exit For

End If

Next

End Sub

ShellWindows

相关推荐