有没有ASP限制登陆次数的代码？怎么写？

[复制链接]

温柔乡

电梯直达

1^#

发表于 2010-1-17 05:55:08 | 只看该作者回帖奖励

|倒序浏览 |阅读模式

我想实现！比如一个用户同一个IP24小时内只能登陆3次！

我程序的部分登陆代码为：

<%
Dim Action,ComeUrl
Action=Trim(Request("Action"))
Cl.Title="用户登录--" & Cl.Title
if Action="CheckLogin" then
Call User_CheckLogin()
else
Response.write Cl.ReplaceAllFlag(User_ShowLogin())
end if
Function User_ShowLogin()
if Cl.ChkUserLogin then response.Redirect "User_Index.asp"
ComeUrl=Trim(request("ComeUrl"))
if ComeUrl="" then
ComeUrl=Request.ServerVariables("HTTP_REFERER")
if ComeUrl="" or INstr(Lcase(ComeUrl),"showerr")>0 then ComeUrl="Index.asp"
end if
'if UserTableType = "Dvbbs" then
'User_ShowLogin=Replace(Template.html(7),"{%loginaction%}",BbsDir&"login.asp?action=chk")
'else
User_ShowLogin=Replace(Template.html(7),"{%loginaction%}","Login.asp?Action=CheckLogin")
'end if
if Cl.Web_Setting(39)="Yes" then
User_ShowLogin=Replace(User_ShowLogin,"{%getcode%}",Replace(Template.html(16),"{%getcode%}",Cl.GetCode("GetCode")))
else
User_ShowLogin=Replace(User_ShowLogin,"{%getcode%}","")
end if
User_ShowLogin=Replace(User_ShowLogin,"{%comeurl%}",ComeUrl)
End Function
Sub User_CheckLogin()
Dim UserName,Password,CookieDate
Dim TruePassWord,sValidDays,sUserInfo
Dim RsLogin,RsGroup,sAddPoint,i,MsgInfo,sMewMsgN
TruePassWord = Cl.Createpass(16)
UserName = Cl.CheckStr(Trim(Request("UserName")))
Password = Md5(Cl.CheckStr(Trim(Request("Password"))),16)
CookieDate = Cl.ChkClng(Request("CookieDate"))
ComeUrl = Trim(Request("ComeUrl"))
if ComeUrl="" then
ComeUrl=Trim(Request.ServerVariables("HTTP_REFERER"))
if ComeUrl="" then ComeUrl="User_Index.asp?Action=MyInfo"
end if
ComeUrl=LCase(ComeUrl)
if instr(ComeUrl,"reg")>0 or instr(ComeUrl,"User_")>0 then ComeUrl="Index.asp"
if instr(ComeUrl,"login")>0 or instr(ComeUrl,"reg")>0 or instr(ComeUrl,"User_")>0 then ComeUrl="Index.asp"
If Cl.Web_Setting(39)="Yes" Then
if Not Cl.CodeIsTrue(Request("CodeStr"),"GetCode") then Call Cl.OutMsg("验证码校验失败。","Login.Asp?ComeUrl=" & ComeUrl)
end if
if UserName="" or Password="" then
Call Cl.OutMsg("用户名或密码或验证码不能为空！","Login.Asp?ComeUrl=" & ComeUrl)
end if
SQL="Select " & Db.UserID & "," & Db.UserName & "," & Db.UserPassWord & ","&Db.UserReName&"," & Db.UserEmail & "," & Db.UserSex & "," & Db.UserFace & "," & Db.UserFaceWidth & "," & Db.UserFaceHeight & "," & Db.UserIM & "," & Db.UserJoinDate & "," & Db.UserLastLogin & "," & Db.UserLogins & "," & Db.UserQuestion & "," & Db.UserAnswer & "," & Db.UserLastIP & "," & Db.UserDataNum & "," & Db.UserLevel & "," & Db.UserPoint & "," & Db.UserMoney & "," & Db.ChargeType & "," & Db.BeginDate & "," & Db.ValidNum & "," & Db.UserTPassWord & "," & Db.WaitReceive & "," & Db.Received & "," & Db.UserMsg & "," & Db.UserLock & " From " & Db.UserTable & " where " & Db.UserName & "='" & UserName & "'"
Set RsLogin=Cl.Execute_U(SQL)
if RsLogin.bof and RsLogin.eof then
RsLogin.close : set RsLogin=Nothing
Call Cl.OutMsg("用户名或密码错误！！！","Login.Asp?ComeUrl=" & ComeUrl)
End if
if Password<>RsLogin(2) then
RsLogin.close : set RsLogin=Nothing
Call Cl.OutMsg("用户名或密码错误！！！","Login.Asp?ComeUrl=" & ComeUrl)
End if
if RsLogin(17)=6 or RsLogin(17)=7 then
RsLogin.close : set RsLogin=Nothing
Call Cl.OutMsg("对不起，你尚未通过认证，不能登录！","Index.asp")
End if
if RsLogin(27)<>0 then
RsLogin.close : set RsLogin=Nothing
Call Cl.OutMsg("对不起，您的用户名已被管理员锁住，不允许登录，请与本站管理员联系！","Index.asp")
end if
Set RsGroup=Cl.Execute("Select GroupName,GroupImg,LoginPoint,Purview,Purview_Other,arrClassView,arrClassInput,arrClassCheck,arrClassMaster From Cl_UserGroup Where ID="&RsLogin(17)&"")
if RsGroup.Bof and RsGroup.Eof then
ErrMsg="对不起，数据库中找不到您的用户组，请联系管理员解决。你的用户组ID为("&RsLogin(17)&")！"
RsLogin.close : Set RsLogin=Nothing
RsGroup.Close : Set RsGroup = Nothing
Call Cl.OutMsg(ErrMsg,"Index.asp")
End if
sMewMsgN = Cl.newincept(UserName)
If sMewMsgN>0 Then
MsgInfo =sMewMsgN & "||" & Cl.inceptid(1,UserName) & "||" & Cl.inceptid(2,UserName)
Else
MsgInfo = "0||0||null"
End If
Cl.Execute_U("Update " & Db.UserTable & " Set " & Db.UserMsg & "='"&Cl.CheckStr(MsgInfo)&"' Where " & Db.UserID & "="&Clng(RsLogin(0))&"")
if DateDiff("D",RsLogin(11),Now)>0 then
'添加积分
Cl.Execute_U("Update " & Db.UserTable & " Set " & Db.UserLastIP & "='" & Cl.UserTrueIP & "'," & Db.UserLastLogin & "='" & Now & "'," & Db.UserLogins & "=" & Db.UserLogins & "+1," & Db.UserPoint & "=" & Db.UserPoint & "+"&RsGroup(2)&","&Db.UserTPassWord&"='"&TruePassWord&"' Where "&Db.UserID&"=" & RsLogin(0) & "")
else
Cl.Execute_U("Update " & Db.UserTable & " Set " & Db.UserLastIP & "='" & Cl.UserTrueIP & "'," & Db.UserLastLogin & "='" & Now & "'," & Db.UserLogins & "=" & Db.UserLogins & "+1,"&Db.UserTPassWord&"='"&TruePassWord&"' Where "&Db.UserID&"=" & RsLogin(0) & "")
end if
if Cl.UserID=0 then
Set Count = New Cls_Count
Count.DelOnline 0, Cl.UserID, Session(Cl.CacheName & "UserID")(0)
Set Count = Nothing
end if
'Response.Cookies(Cl.Web_Cookies).path = InstallDir
Response.Cookies(Cl.Web_Cookies)("UserID") = RsLogin(0)
Response.Cookies(Cl.Web_Cookies)("UserName") = UserName
Response.Cookies(Cl.Web_Cookies)("Password") = PassWord
Response.Cookies(Cl.Web_Cookies)("TruePassWord")= TruePassWord
Response.Cookies(Cl.Web_Cookies)("UserLevel") = RsLogin(17)
Select Case CookieDate
Case 1 : Response.Cookies(Cl.Web_Cookies).Expires=Date+1
Case 2 : Response.Cookies(Cl.Web_Cookies).Expires=Date+31
Case 3 : Response.Cookies(Cl.Web_Cookies).Expires=Date+365
End Select
sValidDays=RsLogin(22)-DateDiff("D",RsLogin(21),now())
if sValidDays<0 then sValidDays=0
sUserInfo = "ClCMS@@@"& Now & "@@@" & Now & "@@@" & Cl.ScriptName
For i=0 to 26
sUserInfo = sUserInfo & "@@@" & RsLogin(i)
Next
For i=0 to 8
sUserInfo = sUserInfo & "@@@" & RsGroup(i)
Next
sUserInfo = sUserInfo & "@@@" & sValidDays & "@@@ClCMS"
Cl.User_Info=Split(sUserInfo,"@@@")
Session(Cl.CacheName & "UserID") = Cl.User_Info
RsLogin.Close : Set RsLogin = Nothing
RsGroup.Close : Set RsGroup = Nothing
if UserTableType = "Dvbbs" then
if request("CLCMS")<>"Y" then
Response.Write "<meta http-equiv=""refresh"" content=""3;URL=" & ComeUrl & """>" & vbCrLf
Response.Write "<iframe id='LoginUser' width='100%' height='0' frameborder='0' src='" & BbsDir & "Login.Asp?action=chk&Username=" & UserName & "&password=" & Request("Password") & "&CookieDate=" & CookieDate & "&CLCMS=Y'></iframe>" & vbCrLf
Response.Write "<span style='font-size:9pt'>正在登陆，请稍等，3秒后自动<a href='"&ComeUrl&"'>返回</a>...</span>" & vbCrLf
end if
Response.end
end if
response.redirect ComeUrl
End Sub
%>
要怎么实现加到哪？
帮帮我谢谢大家

收藏0

使用道具举报

返回列表

		自动登录	找回密码
密码			注册