如何利用VB统计网页的在线人数？ - 编程论坛

#2

pingguolx2012-03-10 23:14

我也想知道！

#3

事业男儿2012-03-11 09:54

如果有人知道我愿意用适当的价钱购买源码，请用QQ传给我，我的QQ: 439235707

加我QQ时请注明来至VB6论坛，谢谢！

#4

风吹过b2012-03-11 10:17

1，网站要使用 IIS 架设。其它的我不知道如何做。
2，IIS 里有一个网页，ASP格式的，我不知道 ASPX 有没有这个文件。每当一个用户连接时，就自动执行一下这个脚本。
在这个脚本里，有二个函数，一个是增加人数，一个是减少人数。都是IIS 自动触发的。
人数是放在服务器变量中的。
3，隐藏网页，ASP的，只有一行，直接输出这个变量值。
4，VB6程序读取该网页，然后显示出来就是了。

#5

事业男儿2012-03-11 15:17

谢谢！我是用的VB读取htm里面的数据，只是这一行太多的字了我想读取以下代码document.getElementById('ol_info').innerHTML='共 5 人在线,0 位会员,5 位访客, 最多 226 人发生在 2011-06-04 16:20 ';我只想要这个几个字（共 5 人在线）显示在记事本里请版主给一下代码，我已经给分了，谢谢！

只有本站会员才能查看附件，请登录

[ 本帖最后由事业男儿于 2012-3-11 15:23 编辑 ]

#6

风吹过b2012-03-12 08:37

读取整个网页，然后在源代码中查找 document.getElementById('ol_info').innerHTML= 这个字符串，
找到后，然后再从这个字符串结束后开始查找到第1个 ' 为止。然后把字符串截取下来。

如果是直接显示在记事本里，那就要用到 API 函数。
如果是记录在文本文件里，就直接保存就是了。

#7

lowxiong2012-03-12 15:09

asp非常容易做这种统计

#8

事业男儿2012-03-13 13:28

回复 6楼风吹过b

读取整个网页，然后在源代码中查找 document.getElementById('ol_info').innerHTML= 这个字符串，
找到后，然后再从这个字符串结束后开始查找到第1个 ' 为止。然后把字符串截取下来。

如果是直接显示在记事本里，那就要用到 API 函数。
如果是记录在文本文件里，就直接保存就是了。

我是想把它显示在labei里能不能给一个源码谢谢

#9

风吹过b2012-03-13 14:48

以 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 区分

' ■当前在线：15547人 
' ■在线会员：380人 
' ■在线访客：15167人

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, "") + 3 '再从关键字查找所需数据前面的字符
j = InStr(i, txt, "") '查找所需数据后面的字符
m = Mid(txt, i, j - i) '取所需的数据
lab.Caption = tt & " : " & m '显示
End Sub

[ 本帖最后由风吹过b 于 2012-3-13 14:49 编辑 ]

#10

事业男儿2012-03-14 08:37

十分感谢!

#11

a8141532013-05-02 11:21

Private Sub CommandButton1_Click()
 On Error Resume Next
 Set oDoc = CreateObject("htmlfile")
 With CreateObject("WinHttp.WinHttpRequest.5.1")
 .Open "GET", "https://bbs.bccn.net/", False
 .send
 tt = Split(Split(.responsetext, "当前在线：")(1), "</td>")(0)
 oDoc.body.innerHTML = tt
 Set r = oDoc.All.tags("b")
 Debug.Print "当前在线：" & r(0).innerText
 Debug.Print "在线会员：" & r(1).innerText
 Debug.Print "在线访客：" & r(2).innerText
 End With
End Sub