新版的在线维护，除了tag=9那里比较难处理，其他的基本上都可以了。

\'====================================================================
\'=                   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