第二辑、网页：篡改、保留和屏蔽某些内容

蓝天630902 · 发表于 2012-9-10 04:58

本帖最后由蓝天630902 于 2012-9-11 08:43 编辑

前面讲了“第一辑、网页：点击标签，翻页”：http://club.excelhome.net/thread-874608-1-1.html

现在来讲一讲网页内容的篡改，比如说我们要改变百度的“LOGO“图标，那是一件很简单的事情：

Sub 改变百度LOGO()
On Error Resume Next
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate "http://www.baidu.com/"
Do Until .ReadyState = 4
DoEvents
Loop
With .document.all.tags("img")(0)
.Width = 384
.Height = 256
.src = "http://news.xinhuanet.com/ziliao/2003-01/18/xinsrc_56211020910306331093560.gif"
End With
End With
End Sub

复制代码

这里面，是通过改变img(0)标签的宽度（Width ）、高度（Height ）和地址（src ）而实现的。

要说明一点，这种事，只是在本地篡改。所以，你只要刷新一下，就可以恢复原状。

蓝天630902 · 发表于 2012-9-10 04:59

本帖最后由蓝天630902 于 2012-9-10 05:26 编辑

我们，还可以改变它的文字内容：

Sub 改变文字内容()
On Error Resume Next
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate "http://www.baidu.com/"
Do Until .ReadyState = 4
DoEvents
Loop
With .document.all.tags("img")(0)
.Width = 384
.Height = 256
.src = "http://news.xinhuanet.com/ziliao/2003-01/18/xinsrc_56211020910306331093560.gif"
End With
For i = 0 To .document.all.tags("a").Length
.document.all.tags("a")(i).innerHTML = i
Next i
End With
End Sub

复制代码

蓝天630902 · 发表于 2012-9-10 05:00

本帖最后由蓝天630902 于 2012-9-10 05:26 编辑

我们，还可以改变它的文字颜色：

Sub 改变文字颜色()
On Error Resume Next
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate "http://www.baidu.com/"
Do Until .ReadyState = 4
DoEvents
Loop
With .document.all.tags("img")(0)
.Width = 384
.Height = 256
.src = "http://news.xinhuanet.com/ziliao/2003-01/18/xinsrc_56211020910306331093560.gif"
End With
For i = 0 To .document.all.tags("a").Length
.document.all.tags("a")(i).innerHTML = i
Next i
For i = 0 To .document.all.tags("a").Length
.document.all.tags("a")(i).Style.Color = "red"
Next i
.document.getElementById("su").Style.Color = "red"
End With
End Sub

复制代码

蓝天630902 · 发表于 2012-9-10 05:01

本帖最后由蓝天630902 于 2012-9-14 20:59 编辑

甚至，我们可以让它变“空白”：

Sub 空白()
On Error Resume Next
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate "http://www.baidu.com/"
Do Until .ReadyState = 4
DoEvents
Loop
For i = 0 To .document.all.tags("div").Length‘清空所有“div”标签
.document.all.tags("div")(i).innerHTML = ""
Next i
End With
End Sub

复制代码

运行上面的代码后，右上角还有一点没有“清理”干净，现在再接再厉，加一句“.document.all.tags("p")(0).innerHTML = ""”：

Sub 空白()
On Error Resume Next
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate "http://www.baidu.com/"
Do Until .ReadyState = 4
DoEvents
Loop
For i = 0 To .document.all.tags("div").Length
.document.all.tags("div")(i).innerHTML = "" ‘清空所有“div”标签
Next i
.document.all.tags("p")(0).innerHTML = "" ‘清空“p(0)”标签
End With
End Sub

复制代码

应该是很干净了。只剩下“意见反馈”了

Sub 其实更简单()
On Error Resume Next
With CreateObject("InternetExplorer.application")
.Visible = True
.Navigate "http://www.baidu.com/"
Do Until .ReadyState = 4
DoEvents
Loop
.document.all.tags("body")(0).innerHTML = "" '清空“body(0)”标签
End With
End Sub

复制代码

全没了！

你会说了：“什么也没有，还看屁啊！”
“皮”肯定没啥可看到。不过，别急，接着看下去，你就知道它的妙用。

蓝天630902 · 发表于 2012-9-10 05:02

本帖最后由蓝天630902 于 2012-9-11 07:08 编辑

百度太简单，看看用在网易论坛的效果：
1、把网页上部非发言区的文字颜色变“兰”、发言区文字变红；
2、把右边“屏蔽”；
3、只看某网友的发言，因为网易比较缺德，没有Excel Home的“只看该作者”功能，所以没办法“只看某网友的发言”。不过现在不成问题，因为对Vba来说，那是小事情。
……
还有很多事情可以做。

Sub 稍微改变一下惊雷贴样式()
On Error Resume Next
With CreateObject("internetexplorer.application")
.Visible = True
.Navigate "http://bbs.news.163.com/bbs/mil/1193698.html"
Do Until .ReadyState = 4
DoEvents
Loop
For i = 0 To 58
.document.all.tags("a")(i).Style.Color = "Blue"
Next i
With .document.all.tags("img")(0)
.Width = 0
.Height = 0
.src = ""
End With
For i = 94 To 106
With .document.all.tags("img")(i)
.Width = 0
.Height = 0
.src = ""
End With
Next i
For i = 0 To 8
.document.all.tags("h3")(i).innerHTML = ""
Next i
For i = 0 To 8
.document.all.tags("h3")(i).innerHTML = ""
.document.all.tags("h3")(i).parentElement.innerHTML = ""
Next i
For i = 0 To 60
.document.all.tags("ul")(i).innerHTML = ""
Next i
For i = 0 To .document.all.Length
dz = .document.all(i).src
'Cells(i + 1, 1) = dz
If dz Like "*youdao*" Then
.document.all(i).Width = 0
.document.all(i).Height = 0
.document.all(i).src = ""
End If
Next i
For i = 0 To .document.all.tags("div").Length
If .document.all.tags("div")(i).className = "tie-content" Then
.document.all.tags("div")(i).Style.Color = "red"
End If
tt = .document.all.tags("div")(i).all.tags("a")(0).Title
If tt <> "汉风1918" And tt <> "" And tt <> "返回版面网上谈兵" Then
.document.all.tags("div")(i).innerHTML = ""
tt = ""
End If
Next i
End With
End Sub

复制代码

神奇吧？

蓝天630902 · 发表于 2012-9-10 05:03

本帖最后由蓝天630902 于 2012-9-12 17:42 编辑

耶？

昨天，获得一枚

jiu128 · 发表于 2012-9-10 07:28

蓝天630902 发表于 2012-9-10 05:03
耶？

昨天，获得一枚“优秀会员奖章”，哈哈，恭喜一下自己。

我也恭喜一下你了O(∩_∩)O哈哈~

武婷婷 · 发表于 2012-9-10 07:34

刚刚学习 vba 看到这些代码着实有点头大，不过相信以后会看明白的同时恭喜楼主拿奖章 {:soso_e100:}

蓝天630902 · 发表于 2012-9-11 07:40

本帖最后由蓝天630902 于 2012-10-28 16:59 编辑

5楼的只是看一页，如果想看其他页码，有办法吗？
这样的事情，对Vba来说，肯定是小事情：

Sub 惊雷贴只看汉风1918()
ym = "1"
On Error Resume Next
With CreateObject("internetexplorer.application")
      .Visible = True                                                    '网页页面可见
1:
      ym = "," & ym
      .Navigate "http://bbs.news.163.com/bbs/mil/1193698" & ym & ".html" '打开惊雷贴
      Do Until .ReadyState = 4
         DoEvents                                                       '等待惊雷贴加载完毕
      Loop
      'For i = 0 To 58
      '    .document.all.tags("a")(i).Style.Color = "Blue"                '把页面顶部区变蓝色，没必要变色，所以注释掉
      ' Next i
      For i = 0 To .document.all.tags("div").Length                            'ｄｉｖ标签的长度
         If .document.all.tags("div")(i).className = "tie-author-column" Then '判断第ｉ个ｄｉｖ标签的类名（className）是否为：tie-author-column
            .document.all.tags("div")(i).innerHTML = "<a>汉风1918</a>"       '修改成“汉风1918”，这是修改左侧栏。
         End If
         If .document.all.tags("div")(i).className = "tie-page" Then          '判断第ｉ个ｄｉｖ标签的类名（className）是否为：tie-page
            zym = .document.all.tags("div")(i).all.tags("a")(5).href          '取得最后一页地址
         End If
         If .document.all.tags("div")(i).className = "floatLayer" Then       '判断第ｉ个ｄｉｖ标签的类名（className）是否为：floatLayer
            .document.all.tags("div")(i).innerHTML = ""                      '屏蔽右下角的“今日聚焦”窗口
         End If
         tt = .document.all.tags("div")(i).all.tags("a")(0).Title             '第ｉ个ｄｉｖ标签的第0个ａ标签的标题（Title）
         If tt <> "汉风1918" And tt <> "" And tt <> "返回版面网上谈兵" Then '判断第ｉ个ｄｉｖ标签的第0个ａ标签的标题（Title）是否为：汉风1918
            .document.all.tags("div")(i).innerHTML = ""                      '不是“汉风1918”的发言就屏蔽，这是屏蔽发言区。
            tt = ""
         End If
         If .document.all.tags("div")(i).ID = "tie_addtion" Then '判断第ｉ个ｄｉｖ标签的ｉｄ号（ID）是否为：tie_addtion
            .document.all.tags("div")(i).innerHTML = ""          '一次性全部屏蔽右侧栏目，懒得一点一点弄。
         End If
      Next i
      zym = Split(Split(zym, ",")(1), ".")(0)                      '计算最大页码
2:
      ym = InputBox("要退出请输入-1，可输入最大页码为" & zym, "请输入页码")
      If ym = -1 Then MsgBox "退出。": GoTo 3
      If ym > zym Then MsgBox "页码太大，请重新输入。": GoTo 2
      GoTo 1
3:
End With
End Sub

蓝天630902 · 发表于 2012-9-12 09:55

本帖最后由蓝天630902 于 2012-9-12 09:56 编辑

Sub 在标签里面写标签名()
On Error Resume Next
With CreateObject("internetexplorer.application")
      .Visible = True                                              '网页页面可见
      .Navigate "http://club.excelhome.net/thread-917808-1-1.html"  '打开http://club.excelhome.net/thread-917808-1-1.html
      Do Until .ReadyState = 4
         DoEvents                                        '等待http://club.excelhome.net/thread-918831-1-1.html加载完毕
      Loop
      For i = .document.All.Length To 0 Step -1             '标签的长度
         .document.All(i).ScrollIntoView
         t1 = Timer
         Do Until Timer > t1 + 0.01                               '这里等待0.01秒，是为了看看效果
            DoEvents
         Loop
         .document.All(i).innertext = .document.All(i).tagName '写入标签名。
      Next i
End With
End Sub

		自动登录	找回密码
密码			免费注册

[分享] 第二辑、网页：篡改、保留和屏蔽某些内容

评分

评分

评分