亲，您未登录哦！ 登录 | 注册
首页  |  社区  |  工具箱  |  代码库  |  博客  |  招聘  |  文章  |  新闻  |  下载  |  读书
回 帖 发 新 帖 刷新版面

主题：[支持原创] 在线人数统计程序,未调试,仅供参考

圪圪 [专家分：5150] 发布于 2004-02-11 14:54:00

<%@ language="VBScript" %>
<%
'数据库保存在当前目录下的ONLINE.MDB
'数据表是ONLINE
'数据表结构
'SessionID char(40) 用户标识
'ClientIP char(15)  客户IP
'LATime datetime    最后活动时间
'LAURI char(200)    最后活动的URI
'----------------------------------------------------------------------------------
'使用方法:在需要统计的地方用<!-- #include virtual="online.asp" -->
'然后:
' RefreshList()
' If QueryOnLine() Then
'  UpDateOnLine()
'  Else
'   AddOnLine()
' End If
'如果你要统计在线人数或者输出在线人员列表,请自己读取ONLINE表搞定
'----------------------------------------------------------------------------------
'
' 本程序由圪圪执笔,"ASP交流"群集体创作 [2004年2月0日 21:04]
' 功劳是大家的,错误是我自己的………………
'
' 由于是在网吧上网，无法调试，代码也是写了一遍，没有检查
' 可能无法运行，这里只是提供一种思路
'
'----------------------------------------------------------------------------------
Function QueryOnLine() '检查数据库中是否有当前用户的记录
  Dim oCnn,oRs
  Set oCnn=Server.CreateObject("ADODB.Connection")
  Set oRs=Server.CreateObject("ADODB.RecordSet")
  oCnn.Open "Driver={Microsoft Access Driver (*.mdb)};dbq='" & Server.MapPath("ONLINE.MDB") & "'"
  USID=Session.SessionID
  oRs.Open "SELECT * FROM OnLine WHERE SessionID='" & USID & "'",oCnn,2,1
  If oRs.Eof Then
   QueryOnLine=False
   Else
    QueryOnLine=True
  End If
  oRs.Close
  oCnn.Close
  Set oRs=Nothing
  Set oCnn=Nothing
  
End Function
Function AddOnLine() '新加在线用户
  Dim oCnn
  Set oCnn=Server.CreateObject("ADODB.Connection")
  USID=Session.SessionID
  CIP=Request.ServerVariables("REMOTE_ADDR")
  LAT=Time()
  LAU=Request.ServerVariables("SCRIPT_NAME")
  If Request.ServerVariables("QUERY_STRING")<>"" Then
   LAU=LAU & "?" & Request.ServerVariables("QUERY_STRING")
  End If
  oCnn.Open "Driver={Microsoft Access Driver (*.mdb)};dbq='" & Server.MapPath("ONLINE.MDB") & "'"
  oCnn.Execute "INSERT INTO ONLINE (SessionID,ClientIP,LATime,LAURI) VALUES ('" & USID & "','" & CIP &_
                "',#" & LAT & "#,'" & LAU & "')"
  oCnn.Close
  Set oCnn=Nothing
End Function
'----------------------------------------------------------------------------------
Function UpDateOnLine() '更新当前用户
  Dim oCnn,oRs
  Set oCnn=Server.CreateObject("ADODB.Connection")
  Set oRs=Server.CreateObject("ADODB.RecordSet")
  USID=Session.SessionID
  LAT=Time()
  LAU=Request.ServerVariables("SCRIPT_NAME")
  If Request.ServerVariables("QUERY_STRING")<>"" Then
   LAU=LAU & "?" & Request.ServerVariables("QUERY_STRING")
  End If
  oCnn.Open "Driver={Microsoft Access Driver (*.mdb)};dbq='" & Server.MapPath("ONLINE.MDB") & "'"
  oRs.Open "SELECT * FROM ONLINE WHERE SessionID='" & USID & "'",oCnn,2,1
  If oRs.EOF Then
   AddOnLine()
   Else
    oCnn.Execute "UPDATE ONLINE SET LATime=#" & LAT & "#,LAURI='" & LAU & "' WHERE SessionID='" & USID & "'"
  End if
  oRs.Close
  oCnn.Close
  Set oRs=Nothing
  Set oCnn=Nothing
End Function
'----------------------------------------------------------------------------------
Function RefreshList() '刷新用户在线列表
  Dim oCnn,oRs
  Set oCnn=Server.CreateObject("ADODB.Connection")
  Set oRs=Server.CreateObject("ADODB.RecordSet")
  oCnn.Open "Driver={Microsoft Access Driver (*.mdb)};dbq='" & Server.MapPath("ONLINE.MDB") & "'"
  CTM=Time
  TTM=dateadd("s",CTM,-15*60)
  oCnn.Execute "DELETE FROM ONLINE WHERE LATime<#" & TTM & "#"
  oRs.Close
  oCnn.Close
  Set oRs=Nothing
  Set oCnn=Nothing
End Function
%>
本帖地址：  http://bbs.pfan.cn/post/27273.html

回复列表 （共3个回复）

沙发

jim.ma [专家分：1100] 发布于 2004-02-10 23:21:00

.. 学习。.

RefreshList()...............函数里
TTM=dateadd("s",CTM,-15*60)

板凳

braig [专家分：0] 发布于 2004-02-11 09:20:00

  老大，程序果然调不正确，老大你看我的程序，标★的地方是可能有问题的地方，谢谢老大。程序的思路是什麽啊，我不懂，谢谢。
根据老大的程序写的online.asp文件：
Function QueryOnLine() '检查数据库中是否有当前用户的记录
  Dim oCnn,oRs
  Set oCnn=Server.CreateObject("ADODB.Connection")
  Set oRs=Server.CreateObject("ADODB.RecordSet")
  oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1"     ★我连接的是SQL2000，不知道这样对不对？
  USID=Session.SessionID
  oRs.Open "SELECT * FROM OnLine WHERE SessionID='" & USID & "'",oCnn,2,1
  If oRs.Eof Then
   QueryOnLine=False
   Else
    QueryOnLine=True
  End If
  oRs.Close
  oCnn.Close
  Set oRs=Nothing
  Set oCnn=Nothing
  
End Function
Function AddOnLine() '新加在线用户
  Dim oCnn
  Set oCnn=Server.CreateObject("ADODB.Connection")
  USID=Session.SessionID
  CIP=Request.ServerVariables("REMOTE_ADDR")
  LAT=Time()
  LAU=Request.ServerVariables("SCRIPT_NAME")
  If Request.ServerVariables("QUERY_STRING")<>"" Then
   LAU=LAU & "?" & Request.ServerVariables("QUERY_STRING")
  End If
  oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1"
  oCnn.Execute "INSERT INTO ONLINE (SessionID,ClientIP,LATime,LAURI) VALUES ('" & USID & "','" & CIP _           这行<-（★）
               & "',#" & LAT & "#,'" & LAU & "')"
  oCnn.Close
  Set oCnn=Nothing
End Function
'----------------------------------------------------------------------------------
Function UpDateOnLine() '更新当前用户
  Dim oCnn,oRs
  Set oCnn=Server.CreateObject("ADODB.Connection")
  Set oRs=Server.CreateObject("ADODB.RecordSet")
  USID=Session.SessionID
  LAT=Time()
  LAU=Request.ServerVariables("SCRIPT_NAME")
  If Request.ServerVariables("QUERY_STRING")<>"" Then
   LAU=LAU & "?" & Request.ServerVariables("QUERY_STRING")
  End If
  oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1"
  oRs.Open "SELECT * FROM ONLINE WHERE SessionID='" & USID & "'",oCnn,2,1
  If oRs.EOF Then
   AddOnLine()
   Else
    oCnn.Execute "UPDATE ONLINE SET LATime=#" & LAT & "#,LAURI='" & LAU & "' WHERE SessionID='" & USID & "'"
  End if
  oRs.Close
  oCnn.Close
  Set oRs=Nothing
  Set oCnn=Nothing
End Function
'----------------------------------------------------------------------------------
Function RefreshList() '刷新用户在线列表
  Dim oCnn,oRs
  Set oCnn=Server.CreateObject("ADODB.Connection")
  Set oRs=Server.CreateObject("ADODB.RecordSet")
  oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1"
  CTM=Time
  TTM=dateadd("s",-15*60,CTM)
  oCnn.Execute "DELETE FROM ONLINE WHERE LATime<#" & TTM & "#"
  oRs.Close
  oCnn.Close
  Set oRs=Nothing
  Set oCnn=Nothing
End Function
%>

然后是在页面的应用，89dx_showfilename.asp文件：
<!--#include file="online.asp"-->  注意，这里我没用<!-- #include virtual="online.asp" -->形式。
<html>
<head>
。。。。。。
<%
RefreshOnLine()
If QueryOnLine() Then
  UpDateOnLine()
Else
  AddOnLine()
End If
%>
。。。
以下其他代码我调试都没有毛病，所以不写了，也太多。
。。。
</html>
运行结果：
Function QueryOnLine() '检查数据库中是否有当前用户的记录 Dim oCnn,oRs Set oCnn=Server.CreateObject("ADODB.Connection") Set oRs=Server.CreateObject("ADODB.RecordSet") oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1" USID=Session.SessionID oRs.Open "SELECT * FROM OnLine WHERE SessionID='" & USID & "'",oCnn,2,1 If oRs.Eof Then QueryOnLine=False Else QueryOnLine=True End If oRs.Close oCnn.Close Set oRs=Nothing Set oCnn=Nothing End Function Function AddOnLine() '新加在线用户 Dim oCnn Set oCnn=Server.CreateObject("ADODB.Connection") USID=Session.SessionID CIP=Request.ServerVariables("REMOTE_ADDR") LAT=Time() LAU=Request.ServerVariables("SCRIPT_NAME") If Request.ServerVariables("QUERY_STRING")<>"" Then LAU=LAU & "?" & Request.ServerVariables("QUERY_STRING") End If oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1" oCnn.Execute "INSERT INTO ONLINE (SessionID,ClientIP,LATime,LAURI) VALUES ('" & USID & "','" & CIP _ & "',#" & LAT & "#,'" & LAU & "')" oCnn.Close Set oCnn=Nothing End Function '---------------------------------------------------------------------------------- Function UpDateOnLine() '更新当前用户 Dim oCnn,oRs Set oCnn=Server.CreateObject("ADODB.Connection") Set oRs=Server.CreateObject("ADODB.RecordSet") USID=Session.SessionID LAT=Time() LAU=Request.ServerVariables("SCRIPT_NAME") If Request.ServerVariables("QUERY_STRING")<>"" Then LAU=LAU & "?" & Request.ServerVariables("QUERY_STRING") End If oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1" oRs.Open "SELECT * FROM ONLINE WHERE SessionID='" & USID & "'",oCnn,2,1 If oRs.EOF Then AddOnLine() Else oCnn.Execute "UPDATE ONLINE SET LATime=#" & LAT & "#,LAURI='" & LAU & "' WHERE SessionID='" & USID & "'" End if oRs.Close oCnn.Close Set oRs=Nothing Set oCnn=Nothing End Function '---------------------------------------------------------------------------------- Function RefreshList() '刷新用户在线列表 Dim oCnn,oRs Set oCnn=Server.CreateObject("ADODB.Connection") Set oRs=Server.CreateObject("ADODB.RecordSet") oCnn.Open"provider=sqloledb;data source=(local);initial catalog=89dx;uid=sa;pwd=1" CTM=Time TTM=dateadd("s",-15*60,CTM) oCnn.Execute "DELETE FROM ONLINE WHERE LATime<#" & TTM & "#" oRs.Close oCnn.Close Set oRs=Nothing Set oCnn=Nothing End Function %>
Microsoft VBScript 编译器错误 错误 '800a03f6'

缺少 'End'

/iisHelp/common/500-100.asp，行242

Microsoft VBScript 运行时错误 错误 '800a000d'

类型不匹配: 'RefreshOnLine'

/adsl/upfile/89dx_upfile/89dx_showfilename.asp，行26

上面好象把online的原代码也弄出来了，老大请给我讲讲这程序的思路，你写的代码我读不懂啊，刚刚学的，谢谢。

3 楼

圪圪 [专家分：5150] 发布于 2004-02-11 14:49:00

这个思路我不记得上次是哪个的帖子里面我回了
现在找不到了，，，，

我的语言表达能力有限，你还是先看看我的代码吧

我来回复

您尚未登录，请登录后再回复。点此登录或注册

程序员工具箱 new

  • 更多工具

    • 代码片段

  • 模拟键盘（不可按）
  • 碰撞的唐三
  • 精彩奥运热点赛事的实时采集
  • 获取天气动态信息
  • 文件查找
  • python大数据抓取京东电脑销量数据
  • 爬虫技术不仅仅支持数据采集
  • 抓取脉脉APP上的职业信息
  • 爬虫中多线程的运用
  • 四则运算以及一元二次方程
  • 欢迎来共享你的NB代码

    • 本版新帖

  • 送段代码给大家
  • 禁用浏览器后退按钮
  • 各位？在ASP中什么样编写上传图形的程序？
  • 一些网页代码奉献
  • 服务器完全安装手册［绝对经典］
  • 小问题，只要2分钟就可。请教数据库排序的三种方式哪种好。
  • [原创]如何在自己的电脑上建立Web服务器。
  • 总结对于主页调用TOP10的一些经验.
  • 用ADODB.Stream做上传下载
  • [转载]ASP技巧28则(权威版)
  • [转载]数据库查询语言
  • 和大家一起研究探讨一个问题！！ 
  • 请问Replace函数怎么用啊？各位高手，可否举例说明？
  • 圪圪请进，有事请教～希望您能帮忙
  • 给大家收集了一些很实用的参考手册下载！（新）