<!--#include file="../set.asp"-->
<!--#include file="../Inc/Email.asp"-->
<!--#include file="../Inc/Md5.asp"-->
<!--#include file="../Inc/Config.asp"-->
<%
if UserTableType = "Dvbbs" then Response.Redirect BbsDir&"Reg.asp"
if Cl.Web_Info(11)="Close" then
response.Redirect Cl.WebDir&"Showerr.asp?action=Close"
response.end
end if
if Cl.Web_Setting(21)<>"Yes" then Cl.OutErr("<li>对不起，本站暂停新用户注册服务！</li>")
Dim Action
Dim UserName,Password,PwdConfirm,Question,Answer,Sex,Email
Dim UserReName,IDCard,BirthDay,CityInfo,ZipCode,UserTelePhone,UserAddRess
Dim SchoolAge,UserWorking,UserHomePhone,UserMobile
Dim UserIM,CheckNum,CheckUrl,sqlReg,rsReg,PageTitle
Dim strMsg,strTitle,strbody
Dim RsGroup,sChargeType,sValidDays,sGroupPoint
Action=Trim(Request("Action"))
Select Case Lcase(Action)
Case "active"
PageTitle="激活用户"
Reg_Active
Case "check"
Reg_Check
Case "post"
Reg_Post
PageTitle="用户注册成功"
TempStr=RegSuccess
Case "apply"
PageTitle="填写用户注册信息"
TempStr=Template.html(9)
TempStr=Replace(TempStr,"{%limlength%}",Split(Cl.Web_Setting(22),"|")(0))
TempStr=Replace(TempStr,"{%maxlength%}",Split(Cl.Web_Setting(22),"|")(1))
Case Else
PageTitle="服务条款和声明"
TempStr=Template.html(8)
End Select
Response.write Cl.ReplaceAllFlag(TempStr)
Sub Reg_Post()
UserName = Trim(request("UserName"))
Password = Trim(request("Password"))
PwdConfirm = Trim(request("PwdConfirm"))
Question = Trim(request("Question"))
Answer = Trim(request("Answer"))
Sex = Cl.ChkClng(Trim(Request("Sex")))
Email = Trim(request("Email"))
UserIM =sRIM(Trim(Request("Homepage")))&"|||"&sRIM(Trim(Request("QQ")))&"|||"&sRIM(Trim(Request("ICQ")))&"|||"&sRIM(Trim(Request("MSN")))&"|||"&sRIM(Trim(Request("AIM")))&"|||"&sRIM(Trim(Request("YaHoo")))&"|||"&sRIM(Trim(Request("UC")))
UserIM = Server.HTMLencode(UserIM)
UserReName = Trim(request("UserReName"))
IDCard = Trim(request("IDCard"))
BirthDay = Trim(request("BirthDay"))
CityInfo =Server.HTMLencode(sRIM(Trim(request("Country")))&"|||"&sRIM(Trim(request("Province")))&"|||"&sRIM(Trim(request("City"))))
ZipCode = Trim(Request("ZipCode"))
UserTelePhone = Server.HTMLencode(Trim(request("UserTelePhone")))
UserAddRess = Server.HTMLencode(Trim(request("UserAddRess")))
SchoolAge = Server.HTMLencode(Trim(request("SchoolAge")))
UserWorking = Server.HTMLencode(Trim(request("UserWorking")))
UserHomePhone = Server.HTMLencode(Trim(request("UserHomePhone")))
UserMobile = Server.HTMLencode(Trim(request("UserMobile")))
if BirthDay<>"" then
if Not IsDate(BirthDay) then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>出生日期错误！</li>"
end if
end if
if IDCard<>"" then
if Not Isnumeric(IDCard) or len(Cstr(IDCard))<15 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>身份证号码错误！</li>"
end if
end if
if Cl.strLength(UserName)>Cint(Split(Cl.Web_Setting(22),"|")(1)) or Cl.strLength(UserName)<Cint(Split(Cl.Web_Setting(22),"|")(0)) then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>请输入用户名(不能大于"&Split(Cl.Web_Setting(22),"|")(1)&"小于"&Split(Cl.Web_Setting(22),"|")(0)&"个字符)</li>"
else
if Instr(UserName,chr(32))>0 or Instr(UserName,",")>0 or Instr(UserName,chr(34))>0 or Instr(UserName,chr(9))>0 or Instr(UserName,"")>0 then
ErrMsg=ErrMsg+"<br><li>用户名中含有非法字符</li>"
FoundErr=True
end if
end if
if Cl.strLength(Password)>12 or Cl.strLength(Password)<6 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>请输入密码(不能大于12小于6)</li>"
else
if Instr(Password,chr(32))>0 or Instr(Password,",")>0 or Instr(Password,chr(34))>0 or Instr(Password,chr(9))>0 or Instr(Password,"")>0 then
ErrMsg=ErrMsg+"<br><li>密码中含有非法字符</li>"
FoundErr=True
end if
end if
If Trim(Cl.CacheData(10,0))<>"" Then
Dim RegSplitWords
RegSplitWords=split(Cl.CacheData(10,0),",")
For i = 0 to ubound(RegSplitWords)
If Trim(RegSplitWords(i))<>"" Then
If instr(UserName,RegSplitWords(i))>0 or instr(Password,RegSplitWords(i))>0 Then
ErrMsg=ErrMsg+"<br><li>用户名或者密码中含有非法字符(<font color=red>"&RegSplitWords(i)&"</font>)</li>"
FoundErr=True
exit for
End If
End If
next
End If
if Password<>PwdConfirm then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>密码和确认密码不一致</li>"
end if
if Question="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>密码提示问题不能为空</li>"
end if
if Answer="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>密码答案不能为空</li>"
end if
if Sex<>0 and Sex<>1 then Sex=1
if Not Cl.ChkEmail(Email) then
ErrMsg=ErrMsg & "<br><li>您的Email有错误</li>"
FoundErr=True
end if
if FoundErr=True then
Cl.OutErr(ErrMsg)
Response.end
end if
CheckNum = Cl.Createpass(12)
CheckUrl=Request.ServerVariables("HTTP_REFERER")
CheckUrl=left(CheckUrl,instrrev(CheckUrl,"/")) & "Reg.asp?Action=active&UserName=" & UserName & "&Password=" & Password & "&CheckNum=" & CheckNum
sqlReg="Select Top 1 * From " & Db.UserTable & " where " & Db.UserName & "='" & UserName & "' or " & Db.UserEmail & "='" & Email & "'"
set rsReg=server.createobject("adodb.recordset")
OpenConn_U : rsReg.open sqlReg,Conn_U,1,3
if not(rsReg.bof and rsReg.eof) then
rsReg.close:set rsReg=Nothing
Cl.OutErr("<br><li>你注册的用户或者用户邮箱已经存在！请换一个用户名或者用户邮箱再试试！</li>")
End if
Set RsGroup=Cl.Execute("Select ChargeType,ValidDays,GroupPoint From UserGroup Where ID=4")
if Not (RsGroup.Bof and RsGroup.Eof) then
sChargeType = RsGroup(0)
sValidDays = RsGroup(1)
sGroupPoint = RsGroup(2)
else
sChargeType = 1
sValidDays = 0
sGroupPoint = 0
end if
RsGroup.Close : Set RsGroup=Nothing
rsReg.addnew
rsReg(Db.UserName) = UserName
rsReg(Db.UserReName) = UserReName
rsReg(Db.UserPassword) = md5(Password,16)
if IsDate(Birthday) then
rsReg(Db.UserBirthday) = Birthday
end if
rsReg(Db.UserQuestion) = Question
rsReg(Db.UserAnswer) = md5(Answer,16)
rsReg(Db.UserSex) = Sex
rsReg(Db.UserEmail) = Email
rsReg(Db.UserIM) = UserIM
rsReg(Db.UserJoinDate) = Now()
rsReg(Db.UserDataNum) = 0
rsReg(Db.UserLogins) = 0
rsReg(Db.UserLastLogin) = Now()
rsReg(Db.ChargeType) = sChargeType
rsReg(Db.UserPoint) = sGroupPoint
rsReg(Db.BeginDate) = Now()
rsReg(Db.ValidNum) = sValidDays
rsReg(Db.UserCheckNum) = CheckNum
rsReg(Db.UserLastIP) = Cl.UserTrueIP
if Cl.Web_Setting(23)="Yes" then
rsReg(Db.UserLevel) = 7
else
if Cl.Web_Setting(24)="Yes" then
rsReg(Db.UserLevel)= 6
else
rsReg(Db.UserLevel)= 4
end if
end if
rsReg(Db.UserFace) = ""
rsReg(Db.UserFaceWidth) = 60
rsReg(Db.UserFaceHeight)= 60
rsReg(Db.UserTelePhone) = UserTelePhone
rsReg(Db.UserHomePhone) = UserHomePhone
rsReg(Db.UserMobile) = UserMobile
rsReg(Db.CityInfo) = CityInfo
rsReg(Db.UserAddRess) = UserAddRess
rsReg(Db.UserWorking) = UserWorking
rsReg(Db.IDCard) = IDCard
rsReg(Db.ZipCode) = ZipCode
rsReg(Db.SchoolAge) = SchoolAge
rsReg.Update
rsReg.Close : Set rsReg=Nothing
'==========================================================
set rsReg=server.createobject("adodb.recordset")
openconn:rsreg.open "Select "&Db.UserID&","&Db.UserPassWord&","&Db.UserLevel&" From "&Db.UserTable&" Where "&Db.UserName&"='"&UserName&"'",conn,1,1
if Not rsReg.eof then
if rsReg(Db.UserLevel)=4 then
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") = rsReg(0)
Response.Cookies(Cl.Web_Cookies)("UserName") = UserName
Response.Cookies(Cl.Web_Cookies)("Password") = rsReg(1)
Response.Cookies(Cl.Web_Cookies)("UserLevel") = 4
End if
End if
rsReg.close:set rsReg=Nothing
'==========================================================
End Sub
Function RegSuccess()
RegSuccess=Template.html(10)
RegSuccess=Replace(RegSuccess,"{%username%}",UserName)
RegSuccess=Replace(RegSuccess,"{%password%}",PassWord)
if Cl.Web_Setting(23)="Yes" and Cint(Cl.Web_Setting(17))>0 then
strTitle=Replace(Template.Strings(10),"{%webname%}",Cl.Web_Info(0))
strbody=Template.html(12)
strbody=Replace(strbody,"{%username%}",UserName)
strbody=Replace(strbody,"{%password%}",PassWord)
strbody=Replace(strbody,"{%activeurl%}","<a href='"&CheckUrl&"' target=_blank>"&CheckUrl&"</a>")
strbody=Replace(strbody,"{%copyright%}",Cl.Web_info(9))
strbody=Replace(strbody,"{%version%}","<a href='http://www.A"&"spoo.cn' target=_blank>"&Cl.Web_Version(1)&"</a>")
if SendEmail(Email,strTitle,strbody) then
strMsg=Template.Strings(4)
else
strMsg=Template.Strings(7)
end if
else
if Cl.Web_Setting(24)="Yes" then strMsg=Template.Strings(5)
if Cl.Web_Setting(25)="Yes" and Cint(Cl.Web_Setting(17))>0 then
strTitle=Replace(Template.Strings(9),"{%webname%}",Cl.Web_Info(0))
strbody=Template.html(11)
strbody=Replace(strbody,"{%username%}",UserName)
strbody=Replace(strbody,"{%password%}",PassWord)
strbody=Replace(strbody,"{%copyright%}",Cl.Web_info(9))
strbody=Replace(strbody,"{%version%}","<a href='http://www.A"&"spoo.cn' target='_blank'>"&Cl.Web_Version(1)&"</a>")
if SendEmail(Email,strTitle,strbody) then
strMsg=strMsg & Template.Strings(6)
else
strMsg=strMsg & Template.Strings(8)
end if
end if
end if
If Enable_Passport = True Then
Dim ClUpi
Dim iNum
If IsNull(SecurityKey) = False And SecurityKey <> "" And IsNull(arrUpiUrls) = False And arrUpiUrls <> "" Then
ClUpi = Split(arrUpiUrls, "|")
For iNum = 0 To UBound(ClUpi)
Response.Write "<iframe id='AddUser' width='100%' height='0' frameborder='0' src=""" & ClUpi(iNum) & "?action=AddUser&Md5Info=" & MD5(UserName & SecurityKey, 32) & "&name=" & UserName & "&pass=" & MD5(Password, 32) & "&question=" & Question & "&answer=" & Answer & "&Email=" & Email & "&sex=" & Sex & "&lock=0&save=0""></iframe>" & vbCrLf
Next
End If
End If
RegSuccess=Replace(RegSuccess,"{%sendmailmsg%}",strMsg)
End Function
Sub Reg_Active()
username=Trim(Request.QueryString("UserName"))
password=Trim(Request.QueryString("PassWord"))
CheckNum=Trim(Request.QueryString("CheckNum"))
if UserName="" or Password="" or CheckNum="" then
Call Cl.OutMsg("要激活的用户名、密码或者验证码不能为空！","Index.asp")
exit sub
end if
PwdConfirm=md5(password,16)
set rs=server.createobject("adodb.recordset")
sql="select "&Db.UserID&"," & Db.UserEmail & "," & Db.UserLocK & "," & Db.UserLevel & "," & Db.UserCheckNum & " from " & Db.UserTable & " where " & Db.UserName & "='" & username & "' and " & Db.UserPassword & "='" & PwdConfirm &"'"
OpenConn_U
rs.open sql,Conn_U,1,3
if rs.bof and rs.eof then
rs.close:set rs=Nothing
Call Cl.OutMsg("要激活的用户名、密码或者验证码错误！","Index.asp")
else
if rs(Db.UserLock)<>0 then
Call Cl.OutMsg("要激活的用户名已经被管理员锁住，请连系管理员！","Index.asp")
Elseif Cint(rs(Db.UserLevel))<=4 then
Call Cl.OutMsg("您已经是本站认证用户，无需再进行激活，请赶紧登录吧！","Login.Asp")
Elseif CheckNum<>rs(Db.UserCheckNum) then
Call Cl.OutMsg("要激活的用户名、密码或者验证码错误！","Index.asp")
else
if Cl.Web_Setting(24)="Yes" then
rs(Db.UserLevel)=6
rs.update
Call Cl.OutMsg("恭喜你通过了Email验证。请等待管理开通你的帐号。开通后，你就正式正为本站的一员了。","Index.asp")
else
Email=rs(Db.UserEmail)
rs(Db.UserLevel)=4
rs(Db.UserCheckNum)=""
rs.update
rs.close:set rs=Nothing
Call Cl.OutMsg("恭喜你正式成为本站的一员，请赶紧登录吧！","Login.Asp")
end if
end if
rs.close:set rs=Nothing
end if
End Sub
Sub Reg_Check()
UserName=Trim(request.form("username"))
Email=Trim(request.form("email"))
if Cl.strLength(UserName)>Cint(Split(Cl.Web_Setting(22),"|")(1)) or Cl.strLength(UserName)<Cint(Split(Cl.Web_Setting(22),"|")(0)) then
Call Cl.OutMsg("用户名不能大于"&Split(Cl.Web_Setting(22),"|")(1)&"或小于"&Split(Cl.Web_Setting(22),"|")(0)&"个字符","javascript:window.close()")
else
if Instr(UserName,"=")>0 or Instr(UserName,"%")>0 or Instr(UserName,chr(32))>0 or Instr(UserName,"?")>0 or Instr(UserName,"&")>0 or Instr(UserName,";")>0 or Instr(UserName,",")>0 or Instr(UserName,"'")>0 or Instr(UserName,",")>0 or Instr(UserName,chr(34))>0 or Instr(UserName,chr(9))>0 or Instr(UserName,"")>0 or Instr(UserName,"$")>0 then
Call Cl.OutMsg("用户名中含有非法字符","javascript:window.close()")
end if
If Trim(Cl.CacheData(10,0))<>"" Then
Dim RegSplitWords,i
RegSplitWords=split(Cl.CacheData(10,0),",")
For i = 0 to ubound(RegSplitWords)
If Trim(RegSplitWords(i))<>"" Then
If instr(UserName,RegSplitWords(i))>0 Then
Call Cl.OutMsg("用户名中含有非法字符","javascript:window.close()")
exit for
End If
End If
next
End If
end if
if Not Cl.ChkEmail(Email) then
Call Cl.OutMsg("您的邮箱地址错误，请重新输入！","javascript:window.close()")
end if
dim rsCheckReg
set rsCheckReg=Cl.Execute_U("select "&Db.UserID&" from " & Db.UserTable & " where " & Db.UserName & "='" & UserName & "'")
if not(rsCheckReg.bof and rsCheckReg.eof) then
Call Cl.OutMsg("“用户名：" & UserName & "”已经存在！请换一个用户名再试试！","javascript:window.close()")
end if
set rsCheckReg=Nothing
set rsCheckReg=Cl.Execute_U("select "&Db.UserID&" from " & Db.UserTable & " where " & Db.UserEmail & "='" & Email & "'")
if not(rsCheckReg.bof and rsCheckReg.eof) then
Call Cl.OutMsg("“Email：" & Email & "”已经存在！请换一个Email再试试！","javascript:window.close()")
end if
set rsCheckReg=Nothing
Call Cl.OutMsg("恭喜您，你的用户名和Email尚未有人注册，赶紧注册吧！","javascript:window.close()")
End Sub
Function SendEmail(Useremail,MailTitle,Mailbody)
Dim ClEmail
Set ClEmail = New Cls_SendMail
ClEmail.SendObject = Cint(Cl.Web_Setting(17)) '设置选取组件
ClEmail.ServerLoginName = Cl.Web_Setting(19) '您的邮件服务器登录名
ClEmail.ServerLoginPass = Cl.Web_Setting(20) '登录密码
ClEmail.SendSMTP = Cl.Web_Setting(18) 'SMTP地址
ClEmail.SendFromEmail = Cl.Web_Info(8) '发送来源地址
ClEmail.SendFromName = Cl.Web_Info(0) '发送人信息
If ClEmail.ErrCode = 0 Then
ClEmail.SendMail Useremail,MailTitle,Mailbody '执行发送邮件
End If
if ClEmail.ErrCode=0 Then
SendEmail=True
else
SendEmail=False
end if
Set ClEmail = Nothing
End Function
Function sRIM(s)
Dim w
w=Trim(s)
If w<>"" and Not IsNull(w) Then
w=Replace(w,"|","")
End If
sRIM=w
End Function
%>
