\'====================================================================
\'= Copyright (c) 2004,NB联盟 =
\'= All rights reserved. =
\'=------------------------------------------------------------------=
\'= 文件名称:Online.asp =
\'= 摘 要:在线情况维护文件 =
\'=------------------------------------------------------------------=
\'= 最后更新:eason007 =
\'= 最后日期:2004-06-17 =
\'====================================================================
Option Explicit
Response.Buffer=True
Const TimeOver=20
Dim Conn
Dim Rs,SQL
Dim UserId,SessionId,IP
Dim Tag,Key
Set Rs=server.CreateObject("adodb.recordSet")
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "Provider = Microsoft.Jet.OLEDB.4.0; Data Source = "&Server.MapPath("Online.mdb")
Randomize Timer
Key = "NB" & (1+Int(Rnd*1000000000))
Response.Cookies("Key").Path="" \'set cookies path
Response.Cookies("Key").Expires = DateAdd("n",TimeOver,Now())
Tag=0
UserId=12
\'UserId=Request.Cookies ("UserId")
If UserId="" Then UserId=0 \' 0=Guest
If Request.Cookies ("Key")="" Then
Response.Cookies("Key")=Key
SessionId=Key
Else
SessionId=Request.Cookies ("Key")
End If
IP=GetUserIp
\'清理在线记录
\'....
SQL="select UserId,SessionId,IP from [Online] where IP=\'"&IP&"\' and UserId="&UserId&" and SessionId=\'"&SessionId&"\'"
Set Rs=Conn.Execute(SQL)
If Rs.EOF And Rs.BOF Then\'判断库内是否有完整在线记录
\'no
SQL="select UserId from [Online] where IP=\'"&IP&"\'"
Set Rs=Conn.Execute(SQL)
If Not Rs.EOF And Not Rs.BOF Then Tag=Tag+1
SQL="select UserId from [Online] where UserId="&UserId
Set Rs=Conn.Execute(SQL)
If Not Rs.EOF And Not Rs.BOF Then Tag=Tag+3
SQL="select UserId from [Online] where SessionId=\'"&SessionId&"\'"
Set Rs=Conn.Execute(SQL)
If Not Rs.EOF And Not Rs.BOF Then Tag=Tag+5
Select Case Tag
Case 0
\'没有ip、cookies、userid
SQL="insert into [Online] (UserId,IP,SessionId,LTime,STime)"
SQL=SQL&" values ("&UserId&",\'"&IP&"\',\'"&SessionId&"\',\'"&Now()&"\',\'"&Now()&"\')"
Case 1
\'有ip,即网吧用户
\'因如果是刷新或者游客变会员的话,起码有SessionId
\'注:刷新tag=9,游客变会员tag=6
SQL="insert into [Online] (UserId,IP,SessionId,LTime,STime)"
SQL=SQL&" values ("&UserId&",\'"&IP&"\',\'"&SessionId&"\',\'"&Now()&"\',\'"&Now()&"\')"
Case 3
\'有id,
\'身份可能是游客或者会员
\'刷新or重登陆,但排除刷新,因刷新tag=8
If UserId=0 Then
SQL="insert into [Online] (UserId,IP,SessionId,LTime,STime)"
SQL=SQL&" values ("&UserId&",\'"&IP&"\',\'"&SessionId&"\',\'"&Now()&"\',\'"&Now()&"\')"
Else
SQL="update [Online] set IP=\'"&Ip&"\',SessionId=\'"&SessionId&"\',LTime=\'"&Now&"\' where UserId="&UserId
End If
Case 5
\'有sessionid
\'不管他是什么身份,只管更新该台机的所有信息,因为一台机只可以干一件事
SQL="update [Online] set IP=\'"&Ip&"\',UserId="&UserId&",LTime=\'"&Now&"\' where SessionId=\'"&SessionId&"\'"
Case 4
\'有ip、id,但不保证是同一条记录
\'同一记录时,判断为会员换机,update
\'不同时,以id为主,游客insert,会员update
SQL="select UserId from [Online] where IP=\'"&IP&"\' and UserId="&UserId
Set Rs=Conn.Execute(SQL)
If Not Rs.EOF And Not Rs.BOF Then
SQL="update [Online] set IP=\'"&Ip&"\',SessionId=\'"&SessionId&"\',LTime=\'"&Now&"\' where IP=\'"&IP&"\' and UserId="&UserId
Else
If UserId=0 Then
SQL="insert into [Online] (UserId,IP,SessionId,LTime,STime)"
SQL=SQL&" values ("&UserId&",\'"&IP&"\',\'"&SessionId&"\',\'"&Now()&"\',\'"&Now()&"\')"
Else
SQL="update [Online] set IP=\'"&Ip&"\',SessionId=\'"&SessionId&"\',LTime=\'"&Now&"\' where UserId="&UserId
End If
End If
Case 6
\'有ip、sessionid
\'同一记录时,游客变会员,update
\'不同时,参照tag=5,update
SQL="update [Online] set IP=\'"&Ip&"\',UserId="&UserId&",LTime=\'"&Now&"\' where SessionId=\'"&SessionId&"\'"
Case 8
\'有id、sessionid
\'同一记录时,参照tag=5,update
\'不同时,游客时,参照tag=5,update,会员时,以sessionid为主
SQL="select UserId from [Online] where SessionId=\'"&SessionId&"\' and UserId="&UserId
Set Rs=Conn.Execute(SQL)
If Not Rs.EOF And Not Rs.BOF Then
SQL="update [Online] set IP=\'"&Ip&"\',LTime=\'"&Now&"\' where UserId="&UserId
Else
If UserId=0 Then
SQL="update [Online] set IP=\'"&Ip&"\',UserId="&UserId&",LTime=\'"&Now&"\' where SessionId=\'"&SessionId&"\'"
Else
SQL="delete [Online] where UserId="&UserId
Conn.Execute(SQL)
SQL="update [Online] set IP=\'"&Ip&"\',UserId="&UserId&",LTime=\'"&Now&"\' where SessionId="&SessionId&"\'"
End If
End If
Case 9
\'有ip、id、sessionid
\'同一记录时,永远不可能发生
\'不同时,组合:id&ip,id&sessionid,ip&sessionid
\'清理库
SQL="delete [Online] where IP=\'"&Ip&"\' and UserId="&UserId
Conn.Execute(SQL)
SQL="delete [Online] where SessionId=\'"&SessionId&"\' and UserId="&UserId
Conn.Execute(SQL)
SQL="delete [Online] where IP=\'"&Ip&"\' and SessionId=\'"&SessionId&"\'"
Conn.Execute(SQL)
SQL="delete [Online] where UserId="&UserId
Conn.Execute(SQL)
SQL="update [Online] set IP=\'"&Ip&"\',UserId="&UserId&",LTime=\'"&Now&"\' where SessionId=\'"&SessionId&"\'"
End Select
Else
SQL="update [Online] set LTime=\'"&Now()&"\' where IP=\'"&IP&"\' and UserId="&UserId&" and SessionId=\'"&SessionId&"\'"
End If
\'Response.Write SQL&"
"
Conn.Execute(SQL)
SQL="select UserId,IP,SessionId,STime,LTime from [Online]"
Set Rs=Conn.Execute(SQL)
Do While Not rs.eof\'show list
Response.Write rs(0)&"---->"
Response.Write rs(1)&"---->"
Response.Write rs(2)&"---->"
Response.Write rs(3)&"---->"
Response.Write rs(4)&"---->
"
rs.movenext
Loop
Function GetUserIp()
Dim Ip,Tmp
Dim i,IsErr
IsErr=False
If Request.ServerVariables("HTTP_X_ForWARDED_For")="" Then
Ip=Request.ServerVariables("REMOTE_ADDR")
Else
Ip=Request.ServerVariables("HTTP_X_ForWARDED_For")
End If
If Len(Ip)>15 Then
IsErr=True
Else
Tmp=Split(Ip,".")
If Ubound(Tmp)=3 Then
For i=0 To Ubound(Tmp)
If Len(Tmp(i))>3 Then IsErr=True
Next
Else
IsErr=True
End If
End If
If IsErr Then
GetUserIp="1.1.1.1"
Else
GetUserIp=Ip
End If
End Function

