<%
If CheckLogin Then
Response.Status = "301 Moved Permanently"
Response.AddHeader "Location", "index.asp"
Response.Flush:Response.End
End If
If LCase(Request("action")) = "login" Then
Call MemberLogin()
If Founderr = True Then
Call ToErrors(ErrMsg)
End If
Else
Call Main()
End If
Call TPL_Flush()
NewAsp.PageEnd()
Sub Main()
Dim strHTML
strHTML = NewAsp.LoadTemplate("users\login")
strHTML = Replace(strHTML, "{$pagetitle}", TPL_Config(3))
strHTML = Replace(strHTML, "{$channelid}", 0)
strHTML = Replace(strHTML, "{$classid}", 0)
TPL_Scan strHTML
End Sub
Sub TPL_ParseNode(sTokenType, sTokenName, sVariant)
Select Case sTokenType
Case "newasp"
ParseDataNode sTokenName,sVariant
Case Else
End Select
End Sub
Sub ParseDataNode(sToken,sVariant)
On Error Resume Next
Select Case sToken
Case "moremenu"
End Select
If Err Then Err.Clear
End Sub
Sub TPL_ParseArea(sTokenName, sTemplate)
Select Case sTokenName
Case "checkcode=1" : If CLng(NewAsp.MainSetting(23)) = 1 Then TPL_Scan sTemplate
End Select
End Sub
Sub MemberLogin()
On Error Resume Next
If Not IsObject(Conn) Then ConnectionDatabase
Dim Rs,SQL,username, password,usercookies,Group_Setting,UserRegIP
If Trim(Request("username")) <> "" And Trim(Request("password")) <> "" Then
username = NewAsp.CheckBadstr(Request("username"))
password = md5(Request("password"),16)
Else
ErrMsg = ErrMsg + "用户名和密码不能为空！"
Founderr = True
Exit Sub
End If
If NewAsp.IsValidStr(Request("username")) = False Then
ErrMsg = ErrMsg + "用户名中含有非法字符！"
Founderr = True
End If
usercookies = NewAsp.ChkNumeric(Request("CookieDate"))
If CLng(NewAsp.MainSetting(23))=1 Then
If Not NewAsp.CodeIsTrue() Then
ErrMsg = ErrMsg + "验证码校验失败，请返回刷新验证码再试。"
Founderr = True
End If
End If
If Founderr = True Then Exit Sub
'-----------------------------------------------------------------
'系统整合
'-----------------------------------------------------------------
Dim API_NewAsp,API_SaveCookie,SysKey
If API_Enable Then
Set API_Newasp = New API_Conformity
API_NewAsp.NodeValue "action","login",0,False
API_NewAsp.NodeValue "username",UserName,1,False
Md5OLD = 1
SysKey = Md5(API_NewAsp.XmlNode("username") & API_ConformKey,16)
Md5OLD = 0
API_NewAsp.NodeValue "syskey",SysKey,0,False
API_NewAsp.NodeValue "password",Request("password"),0,False
API_NewAsp.SendHttpData
If API_NewAsp.Status = "1" Then
Founderr = True
ErrMsg = API_NewAsp.Message
Exit Sub
Else
API_SaveCookie = API_NewAsp.SetCookie(SysKey,UserName,Password,usercookies)
End If
Set API_Newasp = Nothing
End If
'-----------------------------------------------------------------
If Founderr = True Then Exit Sub
Set Rs = NewAsp.CreateAXObject("ADODB.Recordset")
SQL = "SELECT * FROM [NC_User] WHERE username='" & username & "'"
Rs.Open SQL, Conn, 1, 3
If Rs.BOF And Rs.EOF Then
FoundErr = True
ErrMsg = ErrMsg + "您输入的用户名和密码不正确，请联系管理员！"
Exit Sub
Else
If password <> Rs("password") Then
FoundErr = True
ErrMsg = ErrMsg + "用户名或密码错误！！！"
Exit Sub
End If
If Rs("UserLock") <> 0 Then
Founderr = True
ErrMsg = "你的用户名已被锁定,你不能登陆！如要开通此帐号，请联系管理员。"
Exit Sub
End If
Response.Cookies(NewAsp.CookiesName)("LastTimeDate") = Rs("LastTime")
Response.Cookies(NewAsp.CookiesName)("LastTimeIP") = Rs("userlastip")
Response.Cookies(NewAsp.CookiesName)("LastTime") = Rs("LastTime")
Group_Setting=Split(NewAsp.UserGroupSetting(Rs("UserGrade")), "|||")
UserRegIP = Rs("ip") & ""
If NewAsp.ChkNumeric(Group_Setting(41)) = 1 Then
If NewAsp.UserTrueIP <> UserRegIP Then
FoundErr = True
ErrMsg = ErrMsg + "非法登陆，请使用你注册时的IP地址登陆本系统。您当前的IP：" & NewAsp.UserTrueIP & "如果要修改登陆IP地址，请联系管理员。"
Exit Sub
End If
End If
If Datediff("d",Now(),Rs("LastTime")) <> 0 Then
If Rs("userpoint") < 0 Then
Rs("userpoint") = CLng(Group_Setting(25))
Else
Rs("userpoint") = Rs("userpoint") + CLng(Group_Setting(25))
End If
If Rs("experience") < 0 Then
Rs("experience") = CLng(Group_Setting(32))
Else
Rs("experience") = Rs("experience") + CLng(Group_Setting(32))
End If
If Rs("charm") < 0 Then
Rs("charm") = CLng(Group_Setting(33))
Else
Rs("charm") = Rs("charm") + CLng(Group_Setting(33))
End If
End If
Rs("LastTime") = Now()
Rs("userlastip") = NewAsp.UserTrueIP
Rs("UserLogin") = Rs("UserLogin") + 1
If Len(UserRegIP) < 8 Then
Rs("ip") = NewAsp.UserTrueIP
End If
Rs.Update
'If isnull(usercookies) Or usercookies="" Then usercookies=0
Select Case usercookies
Case 0
Response.Cookies(NewAsp.CookiesName)("usercookies") = usercookies
Case 1
Response.Cookies(NewAsp.CookiesName).Expires=Date+1
Response.Cookies(NewAsp.CookiesName)("usercookies") = usercookies
Case 2
Response.Cookies(NewAsp.CookiesName).Expires=Date+31
Response.Cookies(NewAsp.CookiesName)("usercookies") = usercookies
Case 3
Response.Cookies(NewAsp.CookiesName).Expires=Date+365
Response.Cookies(NewAsp.CookiesName)("usercookies") = usercookies
End Select
Response.Cookies(NewAsp.CookiesName).path = "/"
Response.Cookies(NewAsp.CookiesName)("userid") = Rs("userid")
Response.Cookies(NewAsp.CookiesName)("username") = Rs("username")
Response.Cookies(NewAsp.CookiesName)("password") = Rs("password")
If ""<>Rs("nickname")&"" Then
Response.Cookies(NewAsp.CookiesName)("nickname") = Rs("nickname")
Else
Response.Cookies(NewAsp.CookiesName)("nickname") = Rs("username")
End If
Response.Cookies(NewAsp.CookiesName)("UserGrade") = Rs("UserGrade")
Response.Cookies(NewAsp.CookiesName)("UserGroup") = Rs("UserGroup")
Response.Cookies(NewAsp.CookiesName)("UserClass") = Rs("UserClass")
Response.Cookies(NewAsp.CookiesName)("UserToday") = Rs("UserToday")
Response.Cookies(NewAsp.CookiesName)("userlastip") = NewAsp.UserTrueIP
End If
Rs.Close
Set Rs = Nothing
'-----------------------------------------------------------------
'系统整合
'-----------------------------------------------------------------
If API_Enable Then
Response.Write API_SaveCookie
Response.Flush
If API_LoginUrl <> "0" Then
Response.Write ""
Response.End
End If
End If
'-----------------------------------------------------------------
Dim comeurl
comeurl = Trim(Request("comeurl"))
If Len(comeurl) = 0 Then
comeurl = Request.ServerVariables("HTTP_REFERER")
End If
If InStr(lcase(comeurl),"reg.asp")>0 Or InStr(lcase(comeurl),"users/login.asp")>0 Or Trim(comeurl)="" Or (Not NewAsp.CheckOutLinks) Then
comeurl="index.asp"
Else
comeurl=comeurl
End If
Response.Status = "301 Moved Permanently"
Response.AddHeader "Location", comeurl
End Sub
%>