[asp]统计在线人数情况

以前ASP版本的统计在线。因为是从以前的系统中提取出来的。使用的话要修改下。

 

If Cbool(Application("MARKONLINE")) = True Then CheckOnline()
Function CheckOnline()
    DIM IP,rsPrv,Sql
    If DBSTATE = False Then DbOpen()
    Set rsPrv=Server.CreateObject("ADODB.Recordset")
    If Session("UserName") = "" then
        Sql="select * from [Online] where SessionID='"& Session.Sessionid &"'"
        rsPrv.Open Sql,Conn,1,3
        If rsPrv.Eof then
            rsPrv.AddNew
            rsPrv("SessionID") = Session.SessionID
            rsPrv("GroupChargeLv") = -1
            rsPrv("LastActTime")=Now()
            rsPrv("UserIP") = GetIP
            rsPrv("OnLineTime") = 0
            rsPrv("UserWhere") = Request.ServerVariables("HTTP_REFERER")
        Else
            rsPrv("UserWhere") = Request.ServerVariables("HTTP_REFERER")
            rsPrv("OnLineTime") = rsPrv("OnLineTime") + DateDiff("n",rsPrv("LastActTime"),Now())
            rsPrv("LastActTime") = Now()
        End If
        rsPrv.Update
        rsPrv.Close()
        'response.Write "notlogin"
    Else
        'response.Write "logined"
        Sql="select * from [Online] where UserName='"& Session("UserName") &"'"
        rsPrv.Open sql,Conn,1,3
        If rsPrv.Eof then
            rsPrv.AddNew
            rsPrv("SessionID") = Session.SessionID
            rsPrv("UserName") = Session("UserName")
            rsPrv("GroupChargeLv") = Session("GroupChargeLv")
            rsPrv("LastActTime") = Now()
            rsPrv("OnLineTime") = 0
            rsPrv("UserIP")= GetIP
            rsPrv("UserWhere") = Request.ServerVariables("HTTP_REFERER")
        Else
            If rsPrv("SessionID") <> Session.SessionID And Application("LoginSet")(1) = False Then
                Response.Write("<script>alert('该帐户已在其他地方登陆，网站设置1个ID只能有1个登陆\n你可以稍候尝试登陆。');location.href='LoginOut.asp'")
                Response.End()
            End If
            rsPrv("UserWhere") = Request.ServerVariables("HTTP_REFERER")
            rsPrv("OnLineTime") = rsPrv("OnLineTime") + DateDiff("n",rsPrv("LastActTime"),Now())
            rsPrv("LastActTime")=Now() 
        End If
        rsPrv.Update
        rsPrv.Close()
    End If
    
    If DateDiff("s",Application("OnLineLastDelete"),Now()) > Int(Application("DELETEONLINEDIFF")) Then
        Application.Lock()
            Application("OnLineLastDelete") = now
        Application.UnLock()
        Conn.ExeCute("delete from [Online] where datedIff('s',LastActTime,Now())>"&    Int(Application("CHECKONLINEDIFF") &""))  '删除x秒没有活动的访客
    End If
    Set rsPrv = Nothing
End Function