网站制作学习网ASP→正文:asp检查在线类
字体:

asp检查在线类

ASP 2010/7/1 10:24:00  点击:不统计

学习www.网for站asp制.cn作

asp通过application类来进行检查是否已经登录了,如果登录了则更新登录时间,异地登录采用判断ip,如果不通ip登录,则表示已经登录,第二个ip则不能登录.登录超过20分钟的用户自清除
<%
'在线登录检查用户是否登录
'调用方法如下
'Set a = new user_online
'If(a.checku("b",Now(),a.getip())) Then'假设这里的b是新登录的用户如果已经登录则显示已经登录,否则没有登录
'response.write "已经登录"
'Else
'response.write "没有登录"
'end if
'网站制作学习网,www.forasp.cn,原创转自请注明,QQ419018470
Class user_online
   '用户在线查询,u表示用户名,t表示登录时间,ip表示ip地址,定义forasp_cn为ap的空间名,用户间隔$,内容间隔#
   '用户保存格式 $用户名#登录时间#登录ip$用户名#登录时间#登录ip
   '获取ip地址
  Function getip()
 Dim strIPAddr
 If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"unknown")>0 Then
 strIPAddr=Request.ServerVariables("REMOTE_ADDR")
 ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),",")>0 Then
 strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1,InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
 ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
 strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),1,InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
 Else
 strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
 End If
 If len(strIPAddr)=0 Then strIPAddr ="192.168.1.1"
 GetIP=strIPaddr
  End Function
  '添加用户信息 www.forasp.cn
 public Function checku(ByVal u,ByVal t,ByVal ip)
    Dim u_str,num,flag
 clear_application()'首先调用检查ap是否超过1M大小,如果超过则清空重来.否则刷新用户
 flag = False'设置返回参数'网站制作学习网原创转载请注明,
 flag_= False '设置为是否已经有该人登录
 '开始检查是否存在
 u_str = get_u()
     If (Len(u_str)>0) Then'如果有在线信息则开始检查
   u_str_arr = Split(u_str,"$",-1,1)
   num = UBound(u_str_arr)
   If(num>0) then'如果存在用户
         For i= 1 To UBound(u_str_arr)'循环判断是否存在该用户不同ip
    If(u=Split(u_str_arr(i),"#",-1,1)(0)) Then
      '如果存在该人登录则,判断ip并将flag_设置为true
   flag_ = true
      If(Split(u_str_arr(i),"#",-1,1)(2)=ip) Then'如果存在该用户则判断ip如果相等,则更新用户登录时间
          changet(u)
   else'如果不等则表示在另一个地方登录
          flag = true
   End If
   Exit for
    End if 
         Next
      End if
    End If
   If Not flag_ Then
  call add(u,t,ip)'如果没有该人则添加
  End if
 
     checku = flag
  End Function

  Private Function add(ByVal u,ByVal t,ByVal ip)
  Dim temp_u_str
  temp_u_str = get_u()
  temp_u_str = temp_u_str &"$"&u&"#"&t&"#"&ip
  Set_u(temp_u_str)
  End function
  '删除某个登录信息
  Private Function delu(ByVal u)
   Dim u_str,num,temp_u_str
 u_str  = get_u()
 If Len(u_str)>0 Then
   u_str_arr = Split(u_str,"$",-1,1)
      num = UBound(u_str_arr)
  If num >0 then
     For i = 1 To num'循环查询用户该删除时则删除
         If(Split(u_str_arr(i),"#",-1,1)(0)<>u) then
         temp_u_str = temp_u_str & "$" & u_str_arr(i)
   End if
        Next
        set_u(temp_u_str)
      End if
    End if
  End function
  '检查是否已经登录了Forasp.cn
 
  '刷新用户信息
  Private Function flash()
     Dim u_str,now_time,num'定义用户字符串
  now_time = now
     u_str = get_u()
  If len(u_str)>0 Then'如果存在用户则刷新用户
   u_str_arr = Split(u_str,"$",-1,1)
   num = UBound(u_str_arr)
   If num>0 then
       For i = 1 To num'循环每一个用户
        u_str_info_arr = Split(u_str_arr(i),"#",-1,1)'获取用户登录时间
  'response.write DateDiff("s",u_str_info_arr(1),now_time)
  If DateDiff("s",u_str_info_arr(1),now_time) > (20*60) then'这里定义过期时间,设置为20分钟20*60秒
        'delu(u_str_info_arr(0))
  End if
     Next
    End if
  End if
  End Function
   '获取所有的用户信息
  Public Function get_u()
      application.lock
   get_u = application("forasp_cn")
   application.unlock
  End Function
  '设置所有用户信息
  Private Function set_u(ByVal str)
      application.lock
   application("forasp_cn") = str
   application.unlock
  End function
  '更新登录时间
  Function changet(ByVal u)
   Dim t,u_str,num,temp_u_str
   '转载%77%77%77请%2E%66%6F%72%61%73%70%2E%63%6E注
   t= Now()
   u_str = get_u()
   If Len(u_str)>0 then
     u_str_arr = Split(u_str,"$",-1,1)
     num = UBound(u_str_arr)
  If num>0 Then
    For i =1 To num
      If Split(u_str_arr(i),"#")(0) = u Then
     temp_u_str = temp_u_str&"$"&u&"#"&t&"#"&Split(u_str_arr(i),"#")(2)
  Else    
     temp_u_str = temp_u_str&u_str_arr(i)
  End If
   Next
     set_u(temp_u_str)
  End if
   End if
  End Function
  Public function t()
  t =Now()
  End function
  '清空所有的登录信息
  Private Function clearu(ByVal u)
    application.lock
 application("forasp_cn") = ""
 application.unlock
  End Function
  '过程信息检查是否已经超过了application大小了
  Private Sub clear_application()
   Dim application_size
   application_size = 1024 *1024 '大小为1M
   If Len(application("forasp_cn"))>application_size Then
     clearu()
   Else
     flash()
   End if
  End sub
End Class
Set a = new user_online
If(a.checku("d",Now(),a.getip())) Then'假设这里的b是新登录的用户如果已经登录则显示已经登录,否则没有登录
response.write "已经登录"
Else
response.write "没有登录"
End If
%>


·上一篇:ByVal >>    ·下一篇:asp类Let Get Set >>
推荐文章
最新文章