<%
If Int(WR_User(0)) < 1 Then Call WRMPS.ErrView("","","会员注册功能暂时关闭，请稍侯再试！",0)
Dim UserName,Pass,PassWord,Code,i,Question,Answer,Flag,regSaveType,NowLoginTime,Integral,CodeAnswer,User
Dim API
Call DBConnBegin()
Set Rs=server.createobject("adodb.recordset")
Select Case WRMPS.CheckStr(Request("Action"),0)
Case "Attestation"
Code = WRMPS.CheckStr(Request("Code"),0)
UserName = WRMPS.CheckStr(Request("User"),0)
If Code = "" Or IsNull(Code) Or UserName = "" Or IsNull(UserName) Then Call WRMPS.ErrView("","","操作错误",0)
If Code = Request.Cookies(CacheName&"Attestation")("Code") And UserName = Request.Cookies(CacheName&"Attestation")("User") Then
'认证成功
PassWord = Request.Cookies(CacheName&"Attestation")("P")
Response.Cookies(CacheName&"Attestation")("Code") = ""
Response.Cookies(CacheName&"Attestation")("User") = ""
Response.Cookies(CacheName&"Attestation")("P") = ""
Conn.Execute("Update WM_Member Set WM_RZEmail = 1 Where WM_UserName = '"&UserName&"'")
Conn.Execute("Update WM_Member Set WM_Key=1 Where WM_UserName='"&UserName&"'")
Conn.Execute("Update WM_Config Set WM_UserNum = WM_UserNum + 1")
Call WRMPS.SCache("UserNum",WRMPS.GetCache("UserNum") + 1)
'API整合接口
If API_Enable Then
Set API = New API_WRMPS
API.LoadXmlFile True
API.UserName=UserName
API.UserStatus=0
Call API.ProcessMultiPing("update")
Set API=Nothing
End If
'登录
Set Rs = Conn.Execute("Select WM_ID,WM_GroupID,WM_Flag,WM_Email From WM_Member Where WM_UserName='"&UserName&"'")
If Not Rs.Eof Then
Flag = Rs(2)
Email = Rs(3)
Integral = Int(Split(Split(Flag,"@")(2),"|")(1))
Call WRDB.SaveConsume(1,UserName,0,0,Integral,0,"第一次登录")
'API整合接口
If API_Enable Then
Set API = New API_WRMPS
API.LoadXmlFile True
API.UserName=UserName
API.PassWord=PassWord
API.CookieDate=0
Call API.ProcessMultiPing("login")
Set API=Nothing
For i=0 To UBound(aUrls)
strUrl=Lcase(aUrls(i))
If Left(strUrl,7)="http://" Then
Response.Write ""
End If
Next
End If
'----------新整合By Berin-----------
If UC_Enable Then
'UC = uc_user_login(UserName,PassWord)
UC = uc_user_login(UserName,PassWord,"","","","")(0)
'If UC <> "" Then Call WRMPS.ErrView("","login.asp","UC："&UC,0)
If Int(UC) < 0 Then
If UC="-1" Then
UC="用户不存在，或者被删除"
ElseIf UC="-2" Then
UC="密码错"
ElseIf UC="-3" Then
UC="安全提问错"
ElseIf UC="-4" Then
UC="用户或密码为空"
End If
Call WRMPS.ErrView("","login.asp","UC："&UC,0)
End If
End If
'----------修改完毕-----------------
'发欢迎邮件
If (WR_Mail(5) <> "NO" And Int(WR_User(1)) > 0) Or Int(WR_Mail(17)) > 0 Then
UrlPath = WR_Setting(4)
MailBody = WR_Mail(6)
MailBody = Replace(MailBody,"{$User}",UserName)
MailBody = Replace(MailBody,"{$Pass}",PassWord)
Subject = "恭喜您注册成为"&WR_Setting(0)&"的会员！"
If WR_Mail(5) <> "NO" And Int(WR_User(1)) > 0 Then Call WRMPS.SendMail(WRTemp.SiteLabel(MailBody&vbCrLf&vbCrLf&WR_Mail(4)),WRTemp.SiteLabel(WR_Setting(0)),WRTemp.SiteLabel(Subject),Email)
If Int(WR_Mail(17)) > 0 Then Call WRDB.SendMessage(UserName,Null,Subject,WRTemp.SiteLabel(MailBody))
UrlPath = WR_Setting(3)
End If
Call WRUser.Login(0,UserName,Rs(0),Rs(1),Flag,WRMPS.GetCache("FlagTime"),PassWord)
End If
Call WRMPS.ErrView("进入会员中心",WR_Setting(3)&"Member/","邮箱确认成功",1)
Else
'认证失败
Response.Cookies(CacheName&"Attestation")("Code") = ""
Response.Cookies(CacheName&"Attestation")("User") = ""
Response.Cookies(CacheName&"Attestation")("P") = ""
Call WRMPS.ErrView("","index.asp","邮箱确认失败",0)
End If
Case "Check"
Select Case WRMPS.CheckStr(Request("w"),0)
Case "u"
UserName = WRMPS.CheckStr(Request("User"),0)
'判断用户名是否禁用
If WRUser.RegUserName(UserName) Then Response.write "此用户名禁止注册":Response.end
SQL = " Where WM_UserName ='"&UserName&"'"
Set Rs = Conn.Execute("Select Top 1 WM_ID From WM_Member"&SQL)
If Not Rs.Eof Then
Response.write "此用户名已被注册"
Response.end
End If
Rs.CLose
Set Rs = Nothing
'API整合接口
If API_Enable Then
Set API = New API_WRMPS
API.LoadXmlFile True
API.UserName=UserName
Call API.ProcessMultiPing("checkname")
End If
'----------新整合By Berin-----------
If UC_Enable Then
UC = uc_user_checkname(UserName)
If Int(UC) < 0 Then
If UC="-1" Then
UC="用户名不合法"
ElseIf UC="-2" Then
UC="包含不允许注册的词语"
ElseIf UC="-3" Then
UC="用户名已经存在"
End If
Response.write "UC："&UC&""
Response.end
End If
End If
'----------修改完毕-----------------
Response.write "此用户名可以注册"
Case "e"
If Int(WR_User(9)) = 0 Then
Email = WRMPS.CheckStr(Request("Email"),0)
SQL = " Where WM_Email ='"&Email&"'"
Set Rs = Conn.Execute("Select Top 1 WM_ID From WM_Member"&SQL)
If Not Rs.Eof Then
Response.write "邮箱不能重复注册"
Response.end
End If
Rs.CLose
Set Rs = Nothing
End If
'----------新整合By Berin-----------
If UC_Enable Then
UC = uc_user_checkemail(Email)
If Int(UC) < 0 Then
If UC="-4" Then
UC="email 格式有误"
ElseIf UC="-5" Then
UC="email 不允许注册"
ElseIf UC="-6" Then
UC="该 email 已经被注册"
End If
Response.write "UC："&UC&""
Response.end
End If
End If
'----------修改完毕-----------------
Response.write "此邮箱可以注册"
End Select
Case "Reg"
Call WRMPS.CheckSubmit()
User = WRMPS.CheckStr(Request.Form("User"),0)
UserName = WRMPS.CheckStr(Request.Form("UserName"),0)
Email = WRMPS.CheckStr(Request.Form("Email"),0)
PassWord = WRMPS.CheckStr(Request.Form("PassWord"),0)
Pass = WRMPS.CheckStr(Request.Form("Pass"),0)
Question = WRMPS.CheckStr(Request.form("Question"),0)
Answer = WRMPS.CheckStr(Request.form("Answer"),0)
Code = WRMPS.CheckStr(Request.form("Code"),0)
CodeAnswer = WRMPS.CheckStr(Request.form("CodeAnswer"),0)
If UserName = "" Or Len(UserName) < Int(Split(WR_User(3),"|")(0)) Or Len(UserName) > Int(Split(WR_User(3),"|")(1)) Then Call WRMPS.ErrView("","","用户名不正确",0)
'判断用户名是否禁用
If WRUser.RegUserName(UserName) Then Call WRMPS.ErrView("","","此用户名禁止注册",0)
'判断同一IP注册间隔时间
If WRUser.RegIPTime Then Call WRMPS.ErrView("","","系统限制同一IP注册时间间隔为"&WR_User(5)&"分钟",0)
If Email = "" Then Call WRMPS.ErrView("","","请填写邮箱地址",0)
If PassWord = "" Or Len(PassWord) < Int(Split(WR_User(4),"|")(0)) Or Len(PassWord) > Int(Split(WR_User(4),"|")(1)) Then Call WRMPS.ErrView("","","用户密码不正确",0)
If Pass <> PassWord Then Call WRMPS.ErrView("","","确认密码不正确",0)
If Question = "" Then Call WRMPS.ErrView("","","请填写密码提示问题",0)
If Answer = "" Then Call WRMPS.ErrView("","","请填写密码提示答案",0)
If WRMPS.CheckCode("Reg",1) Then If Code = "" Or Code <> Session("Code") Then Call WRMPS.ErrView("","","验证码不正确",0)
If WRMPS.CheckCode("Reg",2) and UBound(WR_CodeQA) >= 0 Then If Split(WR_CodeQA(Session("IDQuestionNo")),"|")(1) <> CodeAnswer Then Call WRMPS.ErrView("","","验证问题答案不正确",0)
Session("IDQuestionNo") = ""
Session("Code") = ""
'API整合接口
If API_Enable Then
Set API = New API_WRMPS
API.LoadXmlFile True
API.UserName=UserName
API.PassWord=PassWord
API.EMail=Email
API.Question=Question
API.Answer=Answer
API.Sex=1
Select Case Int(WR_User(7))
Case 0
API.UserStatus = 4
Case 1
API.UserStatus = 0
End Select
Call API.ProcessMultiPing("reguser")
Set API=Nothing
Dim strUrl,turl
For i=0 To UBound(aUrls)
strUrl=Lcase(aUrls(i))
If Left(strUrl,7)="http://" Then
turl=strUrl&"?syskey="&MD5(1,UserName&API_Key)&"&username="&UserName&"&password="&MD5(1,PassWord)&"&savecookie=0||"& turl
End If
Next
WRMPS.SCookies "ApiUrl",turl,0
End If
'----------新整合By Berin-----------
If UC_Enable Then
UC = uc_user_register(UserName,PassWord,Email,"","")
'If UC <> "" Then Call WRMPS.ErrView("返回重新注册",WR_Setting(3)&"reg.asp","UC："&UC,0)
If Int(UC) < 0 Then
If UC="-1" Then
UC="用户名不合法"
ElseIf UC="-2" Then
UC="包含不允许注册的词语"
ElseIf UC="-3" Then
UC="用户名已经存在"
ElseIf UC="-4" Then
UC="email 格式有误"
ElseIf UC="-5" Then
UC="email 不允许注册"
ElseIf UC="-6" Then
UC="该 email 已经被注册"
ElseIf UC="-7" Then
UC="注册信息不全"
End If
Call WRMPS.ErrView("返回重新注册",WR_Setting(3)&"reg.asp","UC："&UC,0)
End If
End If
'----------修改完毕-----------------
RegSaveType = WRUser.RegSave(UserName,PassWord,Email,Question,Answer,Int(WR_User(7)),Null,Null,Null,Null,Null)
If RegSaveType <> "" and IsNUll(RegSaveType) = False Then Call WRMPS.ErrView("","",RegSaveType,0)
If User <> "" And Int(WR_User(10)) > 0 Then Call WRDB.SaveConsume(1,User,0,0,WR_User(10),0,"成功邀请到我们的新会员“"&UserName&"”注册成功")
Select Case Int(WR_User(7))
Case 1
Set Rs = Conn.Execute("Select WM_ID,WM_GroupID,WM_Flag From WM_Member Where WM_UserName='"&UserName&"'")
If Not Rs.Eof Then
Flag = Rs(2)
Integral = Int(Split(Split(Flag,"@")(2),"|")(1))
Call WRDB.SaveConsume(1,UserName,0,0,Integral,0,"第一次登录")
'API整合接口
If API_Enable Then
Set API = New API_WRMPS
API.LoadXmlFile True
API.UserName=UserName
API.PassWord=PassWord
API.CookieDate=0
Call API.ProcessMultiPing("login")
Set API=Nothing
For i=0 To UBound(aUrls)
strUrl=Lcase(aUrls(i))
If Left(strUrl,7)="http://" Then
Response.Write ""
End If
Next
End If
'----------新整合By Berin-----------
If UC_Enable Then
'UC = uc_user_login(UserName,PassWord)
UC=Int(uc_user_login(UserName,PassWord,"","","","")(0))
'If UC <> "" Then Call WRMPS.ErrView("","login.asp","UC："&UC,0)
If Int(UC) < 0 Then
If UC="-1" Then
UC="用户不存在，或者被删除"
ElseIf UC="-2" Then
UC="密码错"
ElseIf UC="-3" Then
UC="安全提问错"
ElseIf UC="-4" Then
UC="用户或密码为空"
End If
Call WRMPS.ErrView("","login.asp","UC："&UC,0)
End If
End If
'----------修改完毕-----------------
Call WRUser.Login(0,UserName,Rs(0),Rs(1),Flag,WRMPS.GetCache("FlagTime"),MD5(2,PassWord))
Else
Call WRMPS.ErrView("返回重新注册",WR_Setting(3)&"reg.asp","用户注册出错，操作错误",0)
End If
Call WRMPS.ErrView("进入会员中心",WR_Setting(3)&"Member/","用户注册成功",1)
Case 2
If WR_Mail(5) <> "NO" Then Call WRMPS.ErrView("","Index.asp","请在24小时内登录您的邮箱查收确认邮件完成后续操作", 1)
End Select
Set Rs = Nothing
Call WRMPS.ErrView("","Index.asp","用户注册成功，请等待管理员的审核",1)
Case Else
Dim IDQuestionNo
Randomize Timer
IDQuestionNo = int(rnd*UBound(WR_CodeQA))
Session("IDQuestionNo") = IDQuestionNo
SitePath = ",会员注册"
SitePath = WRMPS.GetSitePath(-1,SitePath)
Call WRMPS.FsoBegin()
TempStr = WRTemp.SiteTemplates(1,0,3,0)
Call WRMPS.FsoEnd()
User = Request.QueryString
If User <> "" Then
TempStr = WRMPS.GetReplace(TempStr,"{$User}",User)
Else
TempStr = WRMPS.GetReplace(TempStr,"{$User}","")
End If
If Instr(TempStr,"{$IDCode}") > 0 Then
TempStr = WRMPS.GetReplace(TempStr,"{$IsIDCode}",WRMPS.CheckCode("Reg",1))
If WRMPS.CheckCode("Reg",1) Then
TempStr = WRMPS.GetReplace(TempStr,"{$IDCode}","")
Else
TempStr = WRMPS.GetReplace(TempStr,"{$IDCode}"," style=""display:none""")
End If
End If
If IDQuestionNo > -1 Then
TempStr = WRMPS.GetReplace(TempStr,"{$IDQuestion}",Split(WR_CodeQA(IDQuestionNo),"|")(0))
Else
TempStr = WRMPS.GetReplace(TempStr,"{$IDQuestion}","")
End If
If Instr(TempStr,"{$IDQACode}") > 0 and UBound(WR_CodeQA) >= 0 Then
TempStr = WRMPS.GetReplace(TempStr,"{$IsIDQACode}",WRMPS.CheckCode("Reg",2))
If WRMPS.CheckCode("Reg",2) Then
TempStr = WRMPS.GetReplace(TempStr,"{$IDQACode}","")
Else
TempStr = WRMPS.GetReplace(TempStr,"{$IDQACode}"," style=""display:none""")
End If
Else
TempStr = WRMPS.GetReplace(TempStr,"{$IDQACode}"," style=""display:none""")
End If
TempStr = WRTemp.SiteLabel(TempStr)
Call ClassEnd()
Response.write TempStr
End Select
Set Rs = Nothing
Call DBConnEnd()
%>