用VB自动关闭网页广告窗口。vb实现的是更改代理ip。vb 操作 iframe

    用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
      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地址添加到右边的黑名单中，“确定”后以后就会自动关闭这个广告窗口了。如果想浏览它，再把它从黑名单中删除即可。也可以在托盘图标的右键菜单中，控制功能的开/关。
    本程序在Windows 98（IE6.0）和VB6.0企业版下调试通过

==========================================================================

vb实现的是更改代理ip  

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. 
Private Const REG_DWORD As Long = 4 
Private Const REG_SZ = 1 
Private Const HKEY_CURRENT_USER = &H80000001 


Private Sub SetSurrogate(address As String, Port As String) '设置代理服务器的地址跟端口 
Dim str As String 
Dim SubKey As String 
Dim hKey As Long 

str = Trim(address) & ":" & Trim(Port) 
SubKey = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\" 
RegCreateKey HKEY_CURRENT_USER, SubKey, hKey 
RegSetValueEx hKey, "ProxyServer", 0, REG_SZ, ByVal str, LenB(StrConv(str, vbFromUnicode)) + 1 
RegCloseKey hKey 
End Sub 

Private Sub SetEnable() 
Dim SubKey As String 
Dim hKey As Long 

SubKey = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\" 
RegCreateKey HKEY_CURRENT_USER, SubKey, hKey 
RegSetValueEx hKey, "ProxyEnable", 0, REG_DWORD, 1&, 4 
RegCloseKey hKey 
End Sub 

Private Sub SetDisable() 
Dim SubKey As String 
Dim hKey As Long 

SubKey = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\" 
RegCreateKey HKEY_CURRENT_USER, SubKey, hKey 
RegSetValueEx hKey, "ProxyEnable", 0, REG_DWORD, 0&, 4 
RegCloseKey hKey 
End Sub 



Private Sub Command1_Click()'使代理服务器可用 
SetSurrogate "192.168.1.199", "200" 
SetEnable 
End Sub 

Private Sub Command2_Click()'使代理服务器不可用 
SetDisable 
End Sub

========================================================================================

vb 操作 iframe

为什么写这个？

1.操作跨域框架。这个资料很难得，我在网上苦苦找了一个星期。以前研究BHO的时候，也是找了好久的。留此存照。在vb吧提问如何取得跨域框架的控制权，仅有一个人对此关注，并且说很简单，直接分析源代码，或者用DOM等...恩，现在的vb吧确实很少有深刻的内容了。

2.了解IE编程知识。本以为通过一次BHO编程，已经了解一些IE编程技巧了，结果这次写这个程序，又辛苦找了十来天的资料。现在看来，自己果然无知。懂得越多，越觉得自己无知。

下面是代码

 

'需要引用Microsoft Html Object Library，Edanmo's Ole interfaces 1.81 ，Microsoft Internet Controls
'其中，Edanmo's Ole interfaces 1.81是Edanmo写的OLELIB.TLB，请自己在网上搜索下载

'声明一个全局变量数组IframeIE，用来保存网页框架的操作对象；至少我是这么操作的，当然有更好的办法请指教cnoldjohn嬷嬷茶

Private IframeIE() As SHDocVw.WebBrowser

'下面代码的核心是修改自MVP Edanmo的大作
'枚举框架，参数WB是一个webbrowser控件的名称，其中承载着我们要分析的页面
Sub EnumFrames(ByVal WB As WebBrowser)
Dim j As Integer
Dim pContainer As olelib.IOleContainer
Dim pEnumerator As olelib.IEnumUnknown
Dim pUnk As olelib.IUnknown 
'获得页面的Document接口，然后我们就可以对其为所欲为了
Set pContainer = WB.Object.Document
'很奇怪，有时候上面这段对象赋值出错，用下面这句就没有问题了
'Set pContainer = WB.Document
If pContainer.EnumObjects(OLECONTF_EMBEDDINGS, pEnumerator) = 0 Then
Set pContainer = Nothing
Do While pEnumerator.Next(1, pUnk) = 0
On Error Resume Next 
If Err.Number = 0 Then
'将框架页面依次赋值到IframeIE数组中
ReDim Preserve IframeIE(0 To j)
Set IframeIE(j) = pUnk 
j = j + 1
End If
Loop
Set pEnumerator = Nothing
End If
End Sub

以上这段代码的神奇之处在于可以跨域操作框架。