以 bbs.bccn.net 为例。
程序代码:
Option Explicit
Private Const BCCNURL = "http://bbs.bccn.net/"
Private Sub Command1_Click()
WebBrowser1.Navigate BCCNURL
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'当网页被完全载入时发生,如果有框架时,每个框架载入完成时,也会产生该事件,需要用 URL 区分
' <font color="#6595d6">■</font>当前在线:<font color="red"><b>15547</b></font>人<br>
' <font color="#6595d6">■</font>在线会员:<b>380</b>人<br>
' <font color="#6595d6">■</font>在线访客:<b>15167</b>人
Dim doc As Object
Dim htmtxt As String
If URL = BCCNURL Then '完成的网址是 所需的网址则处理
Set doc = pDisp.Document.body.createTextRange() '设置DOC指向 源代码的 body 部分
htmtxt = doc.htmltext '取 HTML代码,该对像有二个属性,另一个属性是 显示的txt 内容。看所需的内容进行选择
Call 显示数据(htmtxt, "当前在线", Label1) '因为这三个数据的格式相同,仅关键字不同,所以可以单独定义一个函数进行调用
Call 显示数据(htmtxt, "在线会员", Label2)
Call 显示数据(htmtxt, "在线访客", Label3)
End If
End Sub
Private Sub 显示数据(txt As String, tt As String, lab As Label)
Dim i As Long, j As Long
Dim m As String
'这里需要多次测试,并且要注意查看每次的结果值,以确定找对了关键字。不同的浏览器版本,稍有区别,需要仔细测试。
i = InStr(1, txt, tt) '查找关键字
i = InStr(i, txt, "<B>") + 3 '再从关键字查找 所需数据前面的字符
j = InStr(i, txt, "</B>") '查找所需数据后面的字符
m = Mid(txt, i, j - i) '取所需的数据
lab.Caption = tt & " : " & m '显示
End Sub
[
本帖最后由 风吹过b 于 2012-3-13 14:49 编辑 ]