www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\ask\register.asp

    <!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/md5.asp"-->
<!--#include file="inc/chkinput.asp"-->
<!--#include file="inc/cls_email.asp"-->
<%
Dim HtmlContent,Action,strReturnURL
Dim m_strQuestion,m_strAnswerName
strReturnURL = Trim(Request("ReturnURL"))
If CheckeIsURL(strReturnURL) Then
	If LCase(Mid(strReturnURL,8,Len(Request.ServerVariables("SERVER_NAME"))))=LCase(Request.ServerVariables("SERVER_NAME")) Then
		strReturnURL = Server.HTMLEncode(strReturnURL)
	Else
		strReturnURL = ""
	End If
Else
	strReturnURL = ""
End If
Action = NewAsp.CheckBadstr(Request("action"))
If NewAsp.UserID > 0 Then
	Response.Redirect (NewAsp.InstallDir)
End If
Select Case LCase(Action)
	Case "save"
		NewAsp.ChcekProxy(NewAsp.Asked_Setting(21))
		Call saveRegister()
	Case Else
		Call showmain()
End Select

NewAsp.CloseConn()

Sub showmain()
	HtmlContent = NewAsp.LoadTemplate("register")
	HtmlContent = Replace(HtmlContent, "{$HeadTitle}", "用户注册")
	HtmlContent = Replace(HtmlContent, "{$ReturnURL}", strReturnURL)
	If checkask=True Then
		HtmlContent = Replace(HtmlContent, "{$RegQuestion}", m_strQuestion)
		HtmlContent = Replace(HtmlContent, "{$AnswerName}", m_strAnswerName)
	Else
		HtmlContent = Replace(HtmlContent, "{$RegQuestion}", "没有问题")
		HtmlContent = Replace(HtmlContent, "{$AnswerName}", "95d565ef66e7dff9")
	End If
	HtmlContent = Replace(HtmlContent, "{$ClassID}", 0)
	Response.Write NewAsp.ArchiveHtml(HtmlContent)
End Sub

Sub saveRegister()
	Dim username,loginpass,UserPassword,verifypass,useremail
	Dim usersex,question,answer,strIntro,strRandomcode
	Dim Rs,SQL,i
	If CLng(NewAsp.Asked_Setting(16))=0 Then
		Response.Write "<script>alert('友情提示!\n\n本站暂时禁止新用户注册!');</script>"
		Exit Sub
	End If
	Response.Write "<script language=""JavaScript"">function resetcode(){try{var obj=top.document.getElementById('verifycodeimg');obj.src='inc/getcode.asp?t='+Math.random();}catch(e){}}</script>"
	username = Trim(Request.Form("username"))
	If NewAsp.strLength(username)<CLng(NewAsp.Asked_Setting(27)) Or NewAsp.strLength(username)>CLng(NewAsp.Asked_Setting(28)) Then
		Response.Write "<script>alert('用户名不能小于"&NewAsp.Asked_Setting(27)&"或者大于"&NewAsp.Asked_Setting(28)&"个字节!\n提示：一个中文字=2个字节');resetcode();</script>"
		Exit Sub
	Else
		If ChkIsBadstr(username) = False Then
			Response.Write "<script>alert('友情提示!\n\n用户名中包含非法字符!');resetcode();</script>"
			Exit Sub
		End If
	End If
	If Not CheckUserNameString(username) Then
		Response.Write "<script>alert('友情提示!\n\n您的用户中含有非法字符，禁止注册!');resetcode();</script>"
		Exit Sub
	End If
	username = NewAsp.RequestForm("username",35)
	loginpass = Trim(Request.Form("loginpass"))
	verifypass = Trim(Request.Form("verifypass"))
	If loginpass = "" Then
		Response.Write "<script>alert('友情提示!\n\n您的密码不能为空!');resetcode();</script>"
		Exit Sub
	End If
	If verifypass = "" Then
		Response.Write "<script>alert('友情提示!\n\n确认密码不能为空!');resetcode();</script>"
		Exit Sub
	End If
	If loginpass <> verifypass Then
		Response.Write "<script>alert('友情提示!\n\n两次输入的密码不同,请重新输入密码!');resetcode();</script>"
		Exit Sub
	End If
	useremail = NewAsp.RequestForm("useremail",45)
	If Not IsValidEmail(useremail) Then
		Response.Write "<script>alert('友情提示!\n\n邮件地址格式不正确!');resetcode();</script>"
		Exit Sub
	End If
	If Not CheckEmailString(useremail) Then
		Response.Write "<script>alert('友情提示!\n\n您的Email中含有非法字符，禁止使用!');resetcode();</script>"
		Exit Sub
	End If
	usersex = NewAsp.ChkNumeric(Request.Form("sex"))
	question = NewAsp.RequestForm("question",45)
	If question = "" Then
		Response.Write "<script>alert('友情提示!\n\n密码问题不能为空!');resetcode();</script>"
		Exit Sub
	End If
	answer = NewAsp.RequestForm("answer",45)
	If answer = "" Then
		Response.Write "<script>alert('友情提示!\n\n密码答案不能为空!');resetcode();</script>"
		Exit Sub
	End If
	If Not NewAsp.CodeIsTrue() Then
		Response.Write "<script>alert('友情提示!\n\n您的验证码输入错误!');resetcode();</script>"
		Exit Sub
	End If
	If NewAsp.ChkRefresh Then
		Response.Write "<script>alert('友情提示!\n\n本页面起用了防刷新机制,请不要连续刷新本页面!');resetcode();</script>"
		Exit Sub
	End If
	strIntro = NewAsp.RequestForm("Intro",251)

	If CLng(NewAsp.Asked_Setting(31)) = 1 And Len(NewAsp.Asked_Setting(32)) > 1 And Len(NewAsp.Asked_Setting(33)) > 0 Then
		Dim Asklist,n,Canreg
		Canreg=False
		Asklist=Split(NewAsp.Asked_Setting(33),",")
		For n=0 To UBound(Asklist)
			If Request.Form(md5(n,16))>"" Then
				If Trim(LCase(Request.Form(md5(n,16)))) <> Trim(LCase(Asklist(n))) Then
					Response.Write "<script>alert('友情提示!\n\n注册答案错误，请返回刷新页面后重新输入，或者联系管理员。');resetcode();</script>"
					Exit Sub
				Else
					Canreg=True
				End If
				Exit For
			End If
		Next
		If Not Canreg Then
			Response.Write "<script>alert('友情提示!\n\n注册答案不能为空，请返回刷新页面后重新输入，或者联系管理员。');resetcode();</script>"
			Exit Sub
		End If
	End If
	'判断同一IP注册间隔时间
	If IsDate(Session("askregtime")) Then
		If Not IsNull(Session("askregtime")) Or CLng(NewAsp.Asked_Setting(29)) > 0 Then
			If DateDiff("s",Session("askregtime"),Now()) < CLng(NewAsp.Asked_Setting(29)) Then
				Response.Write "<script>alert('友情提示!\n\n本站限制每次注册距离时间为"&NewAsp.Asked_Setting(29)&"秒，请稍后注册。');resetcode();</script>"
				Exit Sub
			End If
		End If
	End If

	Set Rs = NewAsp.Execute("SELECT username FROM NC_Ask_Users WHERE username='" & NewAsp.Checkstr(username) & "'")
	If Not (Rs.BOF And Rs.EOF) Then
		Response.Write "<script>alert('友情提示!\n\n此用户已经存在,请换一个用户名再注册!');resetcode();</script>"
		Exit Sub
	End If
	Set Rs = Nothing
	UserPassword = Md5(loginpass,16)
	strRandomcode = NewAsp.Createpass
	Set Rs = NewAsp.CreateAXObject("ADODB.Recordset")
	SQL = "SELECT * FROM NC_Ask_Users WHERE (userid is null)"
	Rs.Open SQL,Conn,1,3
	Rs.Addnew
		Rs("username") = username
		Rs("password") = UserPassword
		Rs("nickname") = username
		Rs("Randomcode") = strRandomcode
		Rs("UserClass") = 0
		Rs("UserTitle") = "初学弟子"
		Rs("Useremail") = Useremail
		Rs("qq") = ""
		Rs("msn") = ""
		Rs("Usersex") = Usersex
		Rs("userface") = "images/userface/image1.gif"
		Rs("Photo") = ""
		Rs("Homepage") = ""
		Rs("question") = question
		Rs("answer") = md5(answer,16)
		Rs("Intro") = strIntro
		If CLng(NewAsp.Asked_Setting(17))=0 Then
			Rs("Userlock") = 0
		Else
			Rs("Userlock") = 1
		End If
		Rs("addtime") = Now()
		Rs("lastime") = Now()
		Rs("ip") = NewAsp.UserTrueIP
		Rs("lastIP") = NewAsp.UserTrueIP
		Rs("Enternum") = 1
		Rs("Points") = Newasp.ChkNumeric(NewAsp.Point_Setting(0))
		Rs("Experience") = Newasp.ChkNumeric(NewAsp.Point_Setting(1))
		Rs("AnswerPoint") = 0
		Rs("SharePoint") = 0
		Rs("RewardPoint") = 0
		Rs("PunishPoint") = 0
		Rs("Asktotal") = 0
		Rs("Askpend") = 0
		Rs("Askdone") = 0
		Rs("Askvote") = 0
		Rs("Askshare") = 0
		Rs("Askstop") = 0
		Rs("Askoverdue") = 0
		Rs("Answertotal") = 0
		Rs("Adopted") = 0
		Rs("Delnum") = 0
		Rs("Badness") = 0
	Rs.Update
	Rs.Close
	Newasp.Execute ("UPDATE NC_Ask_Setup SET MaxUserNum=MaxUserNum+1")
	NewAsp.ReloadSetupCache Clng(NewAsp.MaxUserNum)+1,6
	Set Rs=NewAsp.Execute("SELECT TOP 1 userid FROM [NC_Ask_Users] ORDER BY userid DESC")
		Newasp.UserID = Rs(0)
	Rs.Close
	Set Rs = Nothing
	Session("askregtime")=Now()
	If CLng(NewAsp.Asked_Setting(17))=0 Then
		Dim StatUserID,UserSessionID
		StatUserID = NewAsp.checkStr(Trim(Request.Cookies(NewAsp.Asked_sn)("StatUserID")))
		If Not IsNumeric(StatUserID) Or StatUserID = "0" Then
			StatUserID = Replace(NewAsp.UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
		StatUserID = Ccur(StatUserID)
		NewAsp.Execute("DELETE FROM NC_Ask_Online WHERE username='" & NewAsp.Checkstr(username) & "' Or id="&StatUserID)
		NewAsp.ReloadSetupCache NewAsp.AskedOnline-1,12
		Response.Cookies(NewAsp.Asked_sn).Path="/"
		Response.Cookies(NewAsp.Asked_sn)("username") = username
		Response.Cookies(NewAsp.Asked_sn)("UserTitle") = "初学弟子"
		Response.Cookies(NewAsp.Asked_sn)("StatUserID") = StatUserID
		Response.Cookies(NewAsp.Asked_sn)("password") = UserPassword
		Response.Cookies(NewAsp.Asked_sn)("Randomcode") = strRandomcode
		Response.Cookies(NewAsp.Asked_sn)("usersex") = Usersex
		Response.Cookies(NewAsp.Asked_sn)("userid") = Newasp.UserID
		NewAsp.UserName = username
		NewAsp.PassWord = UserPassword
		NewAsp.Randomcode = strRandomcode
	End If
	If Len(strReturnURL) > 8 Then
		strReturnURL = strReturnURL
	Else
		strReturnURL = NewAsp.InstallDir
	End If
	Response.Write "<script language='JavaScript'>alert('恭喜您!注册成功');try{"
	Response.Write "top.location='" &strReturnURL& "';"
	Response.Write "}catch(e){}"
	Response.Write "</script>"
End Sub

Function checkask()
	Dim Asklist,n
	If CLng(NewAsp.Asked_Setting(31))=1 And Len(NewAsp.Asked_Setting(32))>0 Then
		Asklist=Split(NewAsp.Asked_Setting(32),",")
		If UBound(Asklist)>=0 And Trim(Asklist(0))<>"" Then
			Randomize()
			n = CInt(UBound(Asklist)*Rnd(now()))
			If n>UBound(Asklist) Then n=UBound(Asklist)
			m_strQuestion=Asklist(n)
			m_strAnswerName=md5(n,16)
			checkask=True
		Else
			checkask=False
		End If
	Else
		checkask=False
	End If
End Function

Function CheckEmailString(str)
	CheckEmailString=False
	If str="" Then Exit Function
	If Len(NewAsp.Asked_Setting(34))<2 Then
		CheckEmailString=True
		Exit Function
	End If
	Dim arr,s,i
	s=NewAsp.Asked_Setting(34)
	arr=Split(s, ",")
	For i=0 To UBound(arr)
		If InStr(LCase(str), LCase(arr(i))) > 0 Then
			CheckEmailString=False
			Exit Function
		End If
	Next
	CheckEmailString=True
End Function

Function CheckUserNameString(str)
	CheckUserNameString=False
	If str="" Then Exit Function
	If Len(NewAsp.Asked_Setting(35))<2 Then
		CheckUserNameString=True
		Exit Function
	End If
	Dim arr,s,i
	s=NewAsp.Asked_Setting(35)
	arr=Split(s, ",")
	For i=0 To UBound(arr)
		If InStr(LCase(str), LCase(arr(i))) > 0 Then
			CheckUserNameString=False
			Exit Function
		End If
	Next
	CheckUserNameString=True
End Function
%>