<!--#include file="../Index_Setting.asp"-->
<!--#include file="../Inc/Cl_ClsEmail.asp"-->
<!--#include file="../Inc/Cl_Md5.asp"-->
<!--#include file="../Inc/Cl_ClsCount.asp"-->
<!--#include file="../Inc/upiconfig.asp"-->
<%
IF HLIntegration = True Then'----------恒浪(Howave.NET)整合开始------------------
Dim ComeUrl
ComeUrl = Request.ServerVariables("HTTP_REFERER")
Response.Redirect HL_Url&Manage_Url&"User_Reg.asp?ComeUrl="&ComeUrl
End IF'--------------------------------恒浪(Howave.NET)整合结束-----------------
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
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(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	= Trim(request("UserTelePhone"))
	UserAddRess		= Trim(request("UserAddRess"))
	SchoolAge		= Trim(request("SchoolAge"))
	UserWorking		= Trim(request("UserWorking"))
	UserHomePhone	= Trim(request("UserHomePhone"))
	UserMobile		= 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 Cl_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=Cl.Execute_U("Select "&Db.UserID&","&Db.UserPassWord&","&Db.UserLevel&" From "&Db.UserTable&" Where "&Db.UserName&"='"&UserName&"'")
	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 Cl_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 Cl_SendEmail(Email,strTitle,strbody) then
			strMsg=strMsg & Template.Strings(6)
			else
			strMsg=strMsg & Template.Strings(8)
			end if
		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 Cl_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
		Cl_SendEmail=True
	else
		Cl_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
%>
<%
'===================================================
' CreateLive CMS Version 3.1
'							Powered by Aspoo.CoM
'===================================================
' Mail: aspoo@126.com, Info@aspoo.cn
' Q  Q: 3315263, 596197794
' Msn : aspoo@126.com, Clw866@hotmail.com
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005 Aspoo.CoM All Rights Reserved.
'===================================================
%>
