源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
查看: 615|回复: 19

[ASP编程] 如何限制同一用户名同时登陆

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2006-6-27 00:00:00 | 显示全部楼层 |阅读模式
这个问题我的办法是,用户有个活跃时间间隔问题。超过这个活跃时间间隔的则可以认为是离线,后者可以登陆 ,如果无后者登陆,但并不是说前者就需要重新登陆了。因为他的session还在的。只能是这个时间设置的越小越精确,也是不能做到绝对的。
代码贴出来给楼主参考下。
Function CheckOnline()

	DIM IP,rsPrv,Sql,PrvDbState
	PrvDbState = False
	If DBSTATE = False Then
		DbOpen()
		PrvDbState = True
	End If
	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
				InfoTo "LoginOut.asp","该帐户已在其他地方登陆,网站设置1个ID只能有1个登陆\n你可以稍候尝试登陆。"
				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
	Set rsPrv = Nothing
	
	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
	
	If PrvDbState = True Then DbClose()
	
End Function
回复

使用道具 举报

0

主题

1万

回帖

87

积分

注册会员

Rank: 2

积分
87
发表于 2022-8-27 06:06:29 | 显示全部楼层
源码源码源码源码源码源码源码源码源码源码源码源码源码
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

67

积分

注册会员

Rank: 2

积分
67
发表于 2022-8-30 06:59:18 | 显示全部楼层
灌灌灌灌水
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2022-12-5 01:53:52 | 显示全部楼层
啦啦啦啦啦啦哈哈哈
回复 支持 反对

使用道具 举报

1

主题

2万

回帖

55

积分

注册会员

Rank: 2

积分
55
发表于 2022-12-13 00:38:24 | 显示全部楼层
加快速度很快就撒谎
回复 支持 反对

使用道具 举报

0

主题

2万

回帖

120

积分

注册会员

Rank: 2

积分
120
发表于 2023-9-3 17:42:54 | 显示全部楼层
很不错的样子
回复 支持 反对

使用道具 举报

7

主题

2万

回帖

288

积分

中级会员

Rank: 3Rank: 3

积分
288
发表于 2023-10-10 02:59:52 | 显示全部楼层
dfdsafdsfdsfdsf
回复 支持 反对

使用道具 举报

8

主题

2万

回帖

52

积分

注册会员

Rank: 2

积分
52
发表于 2023-10-23 22:05:48 | 显示全部楼层
谢谢楼主分享
回复 支持 反对

使用道具 举报

15

主题

2万

回帖

122

积分

注册会员

Rank: 2

积分
122
发表于 2023-11-22 03:59:35 | 显示全部楼层
飞飞飞飞飞飞飞飞飞飞飞飞飞
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

67

积分

注册会员

Rank: 2

积分
67
发表于 2024-4-10 03:47:50 | 显示全部楼层
你们谁看了弄洒了可能
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-11-22 03:41 , Processed in 0.137585 second(s), 26 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表