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

蓝天630902 · 发表于 2012-9-14 08:06

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

我们在　第一辑、网页：点击标签，翻页　http://club.excelhome.net/thread-874608-1-1.html
里面讲过如何关闭那些讨厌的东西，但效果不是很好，主要是随着时间的流逝，标签号改变了。
有没有更好的办法解决这样的问题呢？答案是肯定的（不过不要高兴得太早了，哪一天，它连标签名都给改了，就没辙了）
看看下面的方法与第一辑、网页：点击标签，翻页　http://club.excelhome.net/thread-874608-1-1.html的有什么不同：

Sub 关闭讨厌的家伙()
On Error Resume Next
With CreateObject("internetexplorer.application")
.Visible = True
.Navigate "http://de.yusuan.com/page_content.asp?content=98"
Do Until .ReadyState = 4
DoEvents
Loop
t1 = Timer
Do Until Timer > t1 + 5 '这里等5秒，主要是让右侧的讨厌的家伙全部出现，然后关闭它
DoEvents
Loop
For i = 0 To .document.All.tags("div").Length
If .document.All.tags("div")(i).ID = "tq_invit_close" Then .document.All.tags("div")(i).Click '关闭“网站管理员请求和您通话（本系统由TQ提供）”
If .document.All.tags("div")(i).ID = "tq_float_close" Then .document.All.tags("div")(i).Click '关闭“筑业在线客服”
If .document.All.tags("div")(i).ID = "TQMiniMessWrap" Then .document.All.tags("div")(i).innerHTML = "" '关闭“筑业软件留言系统”
Next i
End With
End Sub

复制代码

蓝天630902 · 发表于 2012-9-14 08:48

其实呢，上面的还可以做得更干净些：

Sub 关闭讨厌的家伙()
On Error Resume Next
With CreateObject("internetexplorer.application")
.Visible = True
.Navigate "http://de.yusuan.com/page_content.asp?content=98"
Do Until .ReadyState = 4
DoEvents
Loop
t1 = Timer
Do Until Timer > t1 + 5 '这里等5秒，主要是让右侧的讨厌的家伙全部出现，然后关闭它
DoEvents
Loop
For i = 0 To .document.All.tags("div").Length
If .document.All.tags("div")(i).ID = "tq_invit_close" Then .document.All.tags("div")(i).Click '关闭“网站管理员请求和您通话（本系统由TQ提供）”，通过ｉｄ查找
If .document.All.tags("div")(i).ID = "tq_float_close" Then .document.All.tags("div")(i).Click '关闭“筑业在线客服”
If .document.All.tags("div")(i).ID = "TQMiniMessWrap" Then .document.All.tags("div")(i).innerHTML = "" '关闭“筑业软件留言系统”
If .document.All.tags("div")(i).className = "content_divs_body_cnsL2" Then .document.All.tags("div")(i).innerHTML = "" '屏蔽“典型客户”，通过类名查找
If .document.All.tags("div")(i).className = "content_divs_body_cnsR" Then .document.All.tags("div")(i).innerHTML = "" '屏蔽“筑业软件全国服务网络”
Next i
End With
End Sub

复制代码

cumulonimbus · 发表于 2012-9-14 11:10

蓝天630902 发表于 2012-9-14 08:48
其实呢，上面的还可以做得更干净些：

找关闭广告的代码要看ID、CLASSNAME，有些名字特复杂，要如何判断。
比如：http://cache.3q3q.cc:8585/kehuan/11369/
这个网站，我看了半天也没看出哪个是要关闭的按钮？谢谢

cumulonimbus · 发表于 2012-9-14 14:34

蓝天630902 发表于 2012-9-14 08:48
其实呢，上面的还可以做得更干净些：

你这个网站http://de.yusuan.com/page_content.asp?content=98
找关闭广告的代码要看ID、CLASSNAME，有些名字特复杂，要如何判断。
你是如何迅速找出的，你看DIV的classname、id非常多，有几十个，有些靠英文能猜出来，有些的意思却不大好明白。有什么快速的好办吗？

蓝天630902 · 发表于 2012-9-14 15:18

cumulonimbus 发表于 2012-9-14 14:34
你这个网站http://de.yusuan.com/page_content.asp?content=98
找关闭广告的代码要看ID、CLASSNAME，有些 ...

Sub 先看一个东方财富()
On Error Resume Next
With CreateObject("InternetExplorer.Application")
      .Visible = True
      .navigate "http://www.eastmoney.com/"
      Do Until .readyState = 4
         DoEvents
      Loop
      k = 0
      For i = 1 To .document.All.Length - 1
         If .document.All(i).innerText = "关闭" Then
            k = k + 1
            Cells(k, 1) = .document.All(i).tagName
            .document.All(i).innerHTML = ""
         End If
      Next i
End With
End Sub

'这里为什么是“innerText”而不是别的什么呢？
'这是因为两边的广告中的“关闭”是可以复制的“文本”，一般来说“innerText”可见并能复制
'所以这里直接采用“innerText”
'下面再说说“http://de.yusuan.com/page_content.asp?content=98”

cumulonimbus · 发表于 2012-9-14 15:29

蓝天630902 发表于 2012-9-14 15:18
Sub 先看一个东方财富()
On Error Resume Next
With CreateObject("InternetExplorer.Applicat ...

Sub 可视化查找()
With CreateObject("InternetExplorer.Application")
      .Visible = True
      .navigate "http://www.people.com.cn/n/2012/0912/c346186-18987485.html"
      Do Until .readyState = 4
         DoEvents
      Loop
      For i = 0 To .document.All.tags("input").Length - 1
         .document.All.tags("input")(i).Width = 100
         .document.All.tags("input")(i).Height = 100

         .document.All.tags("input")(i).Value = i
         .document.All.tags("input")(i).Style.Color = "red"
      Next i
End With
End Sub
我发现这个程序对人民网不管用哈

蓝天630902 · 发表于 2012-9-14 15:52

cumulonimbus 发表于 2012-9-14 15:29
Sub 可视化查找()
With CreateObject("InternetExplorer.Application")
.Visible = True

又绕进去了，到别的地方去。

现在讲“http://de.yusuan.com/page_content.asp?content=98”，

Sub 再看筑业网()
On Error Resume Next
With CreateObject("InternetExplorer.Application")
      .Visible = True
      .navigate "http://de.yusuan.com/page_content.asp?content=98"
      Do Until .readyState = 4
         DoEvents
      Loop
      t1 = Timer
      Do Until Timer > t1 + 5 '这里等5秒，主要是让右侧的讨厌的家伙全部出现
         DoEvents
      Loop
      k = 0
      For i = 1 To .document.All.Length - 1
         If .document.All(i).innerText = "筑业在线客服" Or .document.All(i).innerText = "筑业软件留言系统" Or Left(.document.All(i).innerText, 11) = "网站管理员请求和您通话" Then
            k = k + 1
            Cells(k, 1) = .document.All(i).tagName
            .document.All(i).parentElement.innerHTML = ""
         End If
      Next i
End With
End Sub

'这里“筑业在线客服”、“筑业软件留言系统”以及“网站管理员请求和您通话（本系统由TQ提供）”都是是可以复制的“文本”。所以也采用“innerText”。
'可是，只是关闭了右下角的，左边只是闪了一下，没关闭；中间的根本就是不反应。
'有点头昏！现在。
'

cumulonimbus · 发表于 2012-9-14 19:15

蓝天630902 发表于 2012-9-14 15:52
又绕进去了，到别的地方去。

现在讲“http://de.yusuan.com/page_content.asp?content=98”，

奇怪，为什么关不掉呢？

引子玄 · 发表于 2012-9-14 20:09

本帖最后由引子玄于 2012-9-14 20:47 编辑

蓝天630902 发表于 2012-9-10 04:59
我们，还可以改变它的文字内容：

关于“清除标签内容”的做法，是否可以借用到XMLHTTP对象的“网页采集”中？
比如：
1、对源码中<div>、、、</div>中的内容提取，XMLHTTP采集来个反向清除，剩下的就是DIV标签内的文本内容了。
2、能否把OUTERHTML的标签提取，引用到XMLHTTP的源码提取中。

蓝天630902 · 发表于 2012-9-14 20:47

引子玄发表于 2012-9-14 20:09
关于“清除标签内容”的做法，是否可以借用到XMLHTTP对象的“网页采集”中？
比如：对源码中、、、中的 ...

XMLHTTP对象，没有像ｉｅ对象那样的丰富的“标签”元素，所以，操作起来只能死气沉沉地用“Replace , Split　”方法，但是它速度快。
关于“清除标签内容”的做法，是否可以借用到XMLHTTP对象的“网页采集”中，我真不清楚。

Vba是微软的，ie是微软的，他们之间很多功能没有挖掘。

Sub 比如说吧()
With CreateObject("InternetExplorer.Application")
      .Visible = True
      .navigate "http://baidu.lehecai.com/lottery/qlc/"
      Do Until .readyState = 4
         DoEvents
      Loop
      .document.body.Style.Zoom = "200%" '屏幕放大2倍
      For i = 0 To .document.All.tags("input").Length - 1
         .document.All.tags("input")(i).Value = .document.All.tags("input")(i).ID
         If .document.All.tags("input")(i).ID = "standard_add_to_list_btn" Then .document.All.tags("input")(i).ScrollIntoView '定位到第i个input元素（input标签）位置
      Next i
End With
End Sub

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

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

评分