www.gusucode.com > 艺术签名文章资讯网源代码 > 艺术签名文章资讯网源代码/624/user/reg.asp

    <!--#include file="config.asp"-->
<!--#include file="../inc/chkinput.asp"-->
<!--#include file="../inc/md5.asp"-->
<!--#include file="../inc/email.asp"-->
<!--#include file="../api/cls_api.asp"-->
<!--#include file="../inc/cls_public.asp"-->
<%
Dim HtmlContent,ChannelRootDir
Dim strRegItem,GetCode

ChannelRootDir = Newasp.InstallDir & "user/"
Newasp.LoadTemplates 9999, 5, 0

HtmlContent = Newasp.HtmlContent
HtmlContent = Replace(HtmlContent,"{$InstallDir}", Newasp.InstallDir)
HtmlContent = Replace(HtmlContent, "{$ChannelID}", 0)
'--频道目录
HtmlContent = Replace(HtmlContent,"{$ChannelRootDir}", ChannelRootDir)
HtmlContent = Replace(HtmlContent,"{$CurrentStation}","用户注册")
HtmlContent = Replace(HtmlContent,"{$PageTitle}","用户注册")
HtmlContent = ReadClassMenu(HtmlContent)
HtmlContent = ReadClassMenubar(HtmlContent)
HtmlContent = HTML.ReadAnnounceList(HtmlContent)
HtmlContent = HTML.ReadStatistic(HtmlContent)
HtmlContent = HTML.ReadUserRank(HtmlContent)

If CInt(Newasp.membergrade) > 0 Then Response.Redirect "index.asp"

If CInt(Newasp.CheckUserReg) <> 1 Then
	ErrMsg = ErrMsg + Newasp.HtmlSetting(1)
	Founderr = True
ElseIf Newasp.CheckStr(Request("action")) = "agree" Then
	Call ApplyMember
ElseIf Newasp.CheckStr(Request("action")) = "reg" Then
	Call RegNewMember
Else
	strRegItem = Newasp.HtmlSetting(5)
	HtmlContent = Replace(HtmlContent,"{$UserManageContent}", Newasp.HtmlSetting(3))
	HtmlContent = Replace(HtmlContent,"{$UserRegItem}", Server.HTMLEncode(strRegItem))
	HtmlContent = Replace(HtmlContent,"{$SiteName}", Newasp.SiteName)
	Response.Write HtmlContent

End If
If Founderr = True Then
	Call Returnerr(ErrMsg)
End If

Sub ApplyMember()
	If Trim(Request.Form("action")) <> "agree" Then
		ErrMsg = ErrMsg + "<li>错误的系统参数！</li>"
		Founderr = True
		Exit Sub
	End If
	HtmlContent = Replace(HtmlContent,"{$UserManageContent}", Newasp.HtmlSetting(4))
	HtmlContent = Replace(HtmlContent,"{$SiteName}", Newasp.SiteName)
	Response.Write HtmlContent
End Sub

Sub RegNewMember()
	Dim Rs,SQL
	Dim UserPassWord,strUserName,strGroupName,Password
	Dim rndnum,num1
	Dim Question,Answer,usersex,sex
	On Error Resume Next
	If Newasp.CheckPost = False Then
		ErrMsg = ErrMsg + "<li>您提交的数据不合法，请不要从外部提交注册。</li>"
		FoundErr = True
	End If
	If Trim(Request.Form("username")) = "" Then
		ErrMsg = ErrMsg + "<li>登录账号不能为空！</li>"
		Founderr = True
	End If
	If Newasp.IsValidStr(Request.Form("username")) = False Then
		ErrMsg = ErrMsg + "<li>登录账号中含有非法字符！</li>"
		Founderr = True
	Else
		strUserName = Newasp.CheckBadstr(Trim(Request.Form("username")))
	End If
	If Trim(Request.Form("nickname")) = "" Then
		ErrMsg = ErrMsg + "<li>用户昵称不能为空！</li>"
		Founderr = True
	End If
	If Newasp.IsValidStr(Request.Form("nickname")) = False Then
		ErrMsg = ErrMsg + "<li>用户昵称中含有非法字符！</li>"
		Founderr = True
	End If
	If Newasp.IsValidPassword(Request.Form("password1")) = False Then
		ErrMsg = ErrMsg + "<li>密码中含有非法字符！</li>"
		Founderr = True
	End If
	If Trim(Request.Form("password1")) <> Trim(Request.Form("password2")) Then
		ErrMsg = ErrMsg + "<li>您输入的密码和确认密码不一致！</li>"
		Founderr = True
	End If
	If IsValidEmail(Request.Form("usermail")) = False Then
		ErrMsg = ErrMsg + "<li>您的Email有错误！</li>"
		Founderr = True
	End If
	If Trim(Request.Form("usersex")) = "" Then
		ErrMsg = ErrMsg + "<li>您的姓别不能为空！</li>"
		Founderr = True
	Else
		usersex = Newasp.CheckBadstr(Request.Form("usersex"))
	End If
	If usersex = "女" Then
		sex = 0
	Else
		sex = 1
	End If
	If Request("verifycode") = "" Then
		ErrMsg = ErrMsg + "<li>请返回输入验证码码。</li>"
		Founderr = True
	ElseIf Session("getcode") = "9999" Then
		Session("getcode") = ""
		ErrMsg = ErrMsg + "<li>请不要重复提交，如需重新登陆请返回登陆页面。</li>"
		Founderr = True
	ElseIf CStr(Session("getcode"))<>CStr(Trim(Request("verifycode"))) Then
		ErrMsg = ErrMsg + "<li>您输入的验证码和系统产生的不一致，请重新输入。</li>"
		Founderr = True
	End If
	Session("getcode") = ""
	Set Rs = Newasp.Execute("SELECT username FROM NC_User WHERE username='" & strUserName & "'")
	If Not (Rs.BOF And Rs.EOF) Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>Sorry！此用户已经存在,请换一个用户名再试！</li>"
		Exit Sub
	End If
	Rs.Close:Set Rs = Nothing
	Set Rs = Newasp.Execute("SELECT username FROM NC_Admin WHERE username='" & strUserName & "'")
	If Not (Rs.BOF And Rs.EOF) Then
		FoundErr = True
		ErrMsg = ErrMsg + "<li>Sorry！此用户已经存在,请换一个用户名再试！</li>"
		Exit Sub
	End If
	Rs.Close:Set Rs = Nothing
	If CInt(Newasp.ChkSameMail) = 1 Then
		Set Rs = Newasp.Execute("SELECT userid FROM NC_User WHERE usermail='" & Newasp.CheckStr(Request("usermail")) & "'")
		If Not Rs.EOF Then
			FoundErr = True
			ErrMsg = ErrMsg + "<li>对不起！本系统已经限制一个邮箱只能注册一个账号。</li><li>此邮箱["&Request("usermail")&"]已经占用，请您换一个邮箱再注册吧。</li>"
		End If
		Rs.Close:Set Rs = Nothing
	End If
	If CInt(Newasp.MailInformPass) = 1 Then
		Randomize
		Do While Len(rndnum) < 8
			num1 = CStr(Chr((57 - 48) * rnd + 48))
			rndnum = rndnum & num1
		loop
		UserPassWord = rndnum
	Else
		UserPassWord = Trim(Request.Form("password2"))
	End If
	Password = md5(UserPassWord)
	Question = Trim(Request.Form("question"))
	Answer = Trim(Request.Form("answer"))
	If Question = "" Then Question = Newasp.GetRandomCode
	If Answer = "" Then Answer = Newasp.GetRandomCode
	'-----------------------------------------------------------------
	'系统整合
	'-----------------------------------------------------------------
	Dim API_Newasp,API_SaveCookie,SysKey
	If API_Enable Then
		Set API_Newasp = New API_Conformity
		API_Newasp.NodeValue "action","reguser",0,False
		API_Newasp.NodeValue "username",strUserName,1,False
		Md5OLD = 1
		SysKey = Md5(API_Newasp.XmlNode("username") & API_ConformKey)
		Md5OLD = 0
		API_Newasp.NodeValue "syskey",SysKey,0,False
		API_Newasp.NodeValue "password",UserPassWord,0,False
		API_Newasp.NodeValue "email",Newasp.CheckStr(Request.Form("usermail")),1,False
		API_Newasp.NodeValue "question",Question,1,False
		API_Newasp.NodeValue "answer",Answer,1,False
		API_Newasp.NodeValue "gender",sex,0,False
		API_Newasp.SendHttpData
		If API_Newasp.Status = "1" Then
			Founderr = True
			ErrMsg =  ErrMsg & API_Newasp.Message
			Exit Sub
		Else
			API_SaveCookie = API_Newasp.SetCookie(SysKey,strUserName,Password,1)
		End If
		Set API_Newasp = Nothing
	End If
	'-----------------------------------------------------------------
	If Founderr = True Then Exit Sub
	Call PreventRefresh  '防刷新
	Set Rs = Newasp.Execute("SELECT GroupName FROM NC_UserGroup WHERE Groupid=3")
	If Rs.BOF And Rs.EOF Then
		strGroupName = "普通会员"
	Else
		strGroupName = Newasp.CheckBadstr(Rs(0))
		If Len(strGroupName) = 0 Then strGroupName = "普通会员"
	End If
	Rs.Close:Set Rs = Nothing
	Set Rs = Server.CreateObject("ADODB.Recordset")
	SQL = "select * from NC_User where (userid is null)"
	Rs.Open SQL,Conn,1,3
	Rs.Addnew
		Rs("username") = strUserName
		Rs("password") = Password
		Rs("nickname") = Newasp.CheckBadstr(Request.Form("nickname"))
		Rs("UserGrade") = 1
		Rs("UserGroup") = strGroupName
		Rs("UserClass") = 0
		If CInt(Newasp.AdminCheckReg) = 1 Then
			Rs("UserLock") = 1
		Else
			Rs("UserLock") = 0
		End If
		Rs("UserFace") = "face/1.gif"
		Rs("userpoint") = CLng(Newasp.AddUserPoint)
		Rs("usermoney") = 0
		Rs("savemoney") = 0
		Rs("prepaid") = 0
		Rs("experience") = 10
		Rs("charm") = 10
		Rs("TrueName") = Newasp.CheckBadstr(Request.Form("username"))
		Rs("usersex") = usersex
		Rs("usermail") = Newasp.CheckStr(Request.Form("usermail"))
		Rs("oicq") = ""
		Rs("question") = Question
		Rs("answer") = md5(Answer)
		Rs("JoinTime") = Now()
		Rs("ExpireTime") = Now()
		Rs("LastTime") = Now()
		Rs("Protect") = 0
		Rs("usermsg") = 0
		Rs("userlastip") = Newasp.GetUserIP
		If CInt(Newasp.AdminCheckReg) = 0 And CInt(Newasp.MailInformPass) = 0 Then
			Rs("userlogin") = 1
		Else
			Rs("userlogin") = 0
		End If
		Rs("UserToday") = "0,0,0,0,0,0,0,0,0,0,0"
		Rs("usersetting") = ",,,,,,,,,,,,,,,,,,,,,,,,,,,,,,"
		Rs("ip") = Newasp.GetUserIP
		Rs("Badness") = 0
		Rs("isask") = 0
	Rs.update
	Rs.Close
	SQL = "SELECT userid,username,password,nickname,UserGrade,UserGroup,UserClass,UserLock,userlogin FROM NC_user WHERE username = '" & Newasp.CheckBadstr(Request.Form("username")) & "' ORDER BY userid DESC"
	Rs.Open SQL, Conn, 1, 3
	If Rs("UserLock") = 0 And CInt(Newasp.MailInformPass) = 0 Then
		Response.Cookies(Newasp.Cookies_Name)("userid") = Rs("userid")
		Response.Cookies(Newasp.Cookies_Name)("username") = Rs("username")
		Response.Cookies(Newasp.Cookies_Name)("password") = Rs("password")
		Response.Cookies(Newasp.Cookies_Name)("nickname") = Rs("nickname")
		Response.Cookies(Newasp.Cookies_Name)("UserGrade") = Rs("UserGrade")
		Response.Cookies(Newasp.Cookies_Name)("UserGroup") = Rs("UserGroup")
		Response.Cookies(Newasp.Cookies_Name)("UserClass") = Rs("UserClass")
		'-----------------------------------------------------------------
		'系统整合
		'-----------------------------------------------------------------
		If API_Enable Then
			Response.Write API_SaveCookie
			Response.Flush
		End If
		'-----------------------------------------------------------------
	End If
	Rs.Close
	Set Rs = Nothing
	'发送注册邮件
	Dim username,useremail,topic,mailbody,strMessage
	If CInt(Newasp.IsCloseMail) = 0 And CInt(Newasp.SendRegMessage) = 1 Then
		username = strUserName
		useremail = Trim(Request.Form("usermail"))
		topic = "您在 " & Newasp.SiteName & " 的注册资料"
		mailbody = Newasp.HtmlSetting(6)
		mailbody = Replace(mailbody,"{$SiteName}", Newasp.SiteName, 1, -1, 1)
		mailbody = Replace(mailbody,"{$SiteUrl}", Newasp.SiteUrl, 1, -1, 1)
		mailbody = Replace(mailbody,"{$UserName}", username, 1, -1, 1)
		mailbody = Replace(mailbody,"{$EmailTopic}", topic, 1, -1, 1)
		mailbody = Replace(mailbody,"{$PassWord}", UserPassWord, 1, -1, 1)
		Select Case CInt(Newasp.SendMailType)
			Case 0
				strMessage = "<li>系统未开启邮件功能，请记住您的注册信息。</li>"
			Case 1
				Call Jmail(useremail, topic, mailbody)
			Case 2
				Call Cdonts(useremail, topic, mailbody)
			Case 3
				Call aspemail(useremail, topic, mailbody)
			Case Else
				strMessage = "<li>系统未开启邮件功能，请记住您的注册信息。</li>"
		End Select
		If SendMail = "OK" Then
			strMessage = "<li>您的注册信息已经发往您的邮箱，[" & Request("usermail") & "] 请注意查收。</li>"
		Else
			strMessage = "<li>由于系统错误，给您发送的注册资料未成功。</li>"
		End If
	End If
	If CInt(Newasp.AdminCheckReg) = 1 Then
		strMessage = strMessage & "<li>请等待管理员认证……</li>"
	End If
	sucmsg = Newasp.HtmlSetting(2)
	sucmsg = Replace(sucmsg, "{$UserName}", Request("username"))
	sucmsg = Replace(sucmsg, "{$Message}", strMessage)
	Call ReturnIndex(sucmsg)
	'-----------------------------------------------------------------
	'系统整合
	'-----------------------------------------------------------------
	If API_Enable Then
		If API_ReguserUrl <> "0" Then
			Response.Write "<script language=JavaScript>"
			Response.Write "setTimeout(""window.location='"& API_ReguserUrl &"'"",1000);"
			Response.Write "</script>"
		End If
	End If
	'-----------------------------------------------------------------
End Sub

Sub ReturnIndex(message)
	Response.Write "<html><head><title>成功提示信息!</title><meta http-equiv=Content-Type content=text/html; charset=gb2312>" & vbCrLf
	Response.Write "<meta http-equiv=refresh content=3;url=index.asp>"
	Response.Write "<link href=user_style.css rel=stylesheet type=text/css></head><body><br /><br />" & vbCrLf
	Response.Write "<table width=460 border=0 align=center cellpadding=0 cellspacing=0>"
	Response.Write "<tr bgcolor='#3795d2'>"
	Response.Write "  <td height='25' valign='top' bgcolor='#3795d2'> <img src='images/user_msg.gif' width=69 height=20></td>"
	Response.Write "  <td align='right' valign='top'> <img src='images/user_login_02.gif' width=4 height=4></td>"
	Response.Write "</tr>"
	Response.Write "<tr>"
	Response.Write "  <td width=526 height=1 colspan=2 bgcolor=#f8f6f5></td>"
	Response.Write "</tr>"
	Response.Write "<tr bgcolor=#f8f6f5>"
	Response.Write "  <td width=355 style='padding-left: 10px;padding-top: 5px;'><b style=color:blue><span id=jump>3</span> 秒钟后系统将自动转到用户管理首页</b><br>" & message & "</td>"
	Response.Write "  <td> <img src='images/user_suc.gif' width=95 height=97></td>"
	Response.Write "</tr>"
	Response.Write "<tr bgcolor=#f8f6f5><td align=center colspan=2><a href=index.asp>返回上一页...</a></td></tr>"
	Response.Write "<tr bgcolor='#3795d2'>"
	Response.Write "  <td height='8' valign='bottom'> <img src='images/user_login_04.gif' width=4 height=4></td>"
	Response.Write "  <td align='right' valign='bottom'> <img src='images/user_login_05.gif' width=4 height=4></td>"
	Response.Write "</tr>"
	Response.Write "</table>"
	Response.Write "<br /><br /></body></html>"
	Response.Write "<script>function countDown(secs){jump.innerText=secs;if(--secs>0)setTimeout(""countDown(""+secs+"")"",1000);}countDown(3);</script>"
End Sub
CloseConn
%>