引用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 />
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>