reg.asp

一个asp写的论坛源代码,论坛所需要的功能都有

<!-- #include file="Conn.asp" -->
<!-- #include file="INC/Const.asp" -->
<!-- #include file="inc/MD5.asp" -->
<%
Dim username,errorchar,i
team.Headers Team.Club_Class(1)& "- 用户注册"
If team.Forum_setting(4) = 0 then 
	team.error team.Forum_setting(5)
End If
UserName=HTMLEncode(Trim(Request.Form("username")))
Dim X1,x2,Fid
If team.UserLoginED Then
	team.error " 欢迎您回来，"&TK_UserName&"。现在将转入首页。<meta http-equiv=refresh content=3;url=""Default.asp""> "
End if
Select Case Request("action")
	Case "myCheck"
		Call myCheck
	Case "callreg"
		CallReg
	Case Else
		Call Main()
End Select

Sub Main()
	If team.Forum_setting(17)=0 Then
		Call myCheck
	Else
		Call RegMain()
	End If
End Sub

Sub RegMain()
	Echo "<form method=""post"" action=""?action=myCheck"">"
	Echo " <table border=""0"" cellspacing=""1"" cellpadding=""3"" width=""95%"" align=""center"" class=""a2"">"
	Echo " <tr class=a1><td><b>TEAM's注册服务条款和声明</b></td></tr>"
	Echo " <tr class=a4><td><table border=0 cellspacing=0 cellpadding=0 width=100% class=a4>"
    Echo " <tr class=a4><td> "& Replace(Ubb_Code(team.Club_Class(13)),"{$clubname}",team.Club_Class(1)) &" </td></tr>"
    Echo " </table></td></tr>"
	Echo " <tr class=a3><td><li><a href=help.asp?action=custom>互联网电子公告服务管理规定</a>"
	Echo " <li><a href=help.asp?action=custom5>联网信息服务管理办法 </a> </td>"
	Echo " </tr></table><BR><input type=submit value=""同 意""></form><BR>"
End Sub

Sub myCheck
	Dim Tmp
	dim Checkname,i,CName,BName,CheckMail,cMail,bMail
	CheckName = Split(team.Club_Class(25),Chr(13)&Chr(10))
	for i=0 to ubound(CheckName)
		If CName="" Then
			CName = CheckName(i)
		Else
			CName = CName & "/"& CheckName(i)
		End if
		If BName="" Then
			BName = CheckName(i)
		Else
			BName = BName & "|"& CheckName(i)
		End if
	Next
	CheckMail = Split(team.Club_Class(23),Chr(13)&Chr(10))
	for i=0 to ubound(CheckMail)
		If cMail="" Then
			cMail = CheckMail(i)
		Else
			cMail = cMail & "/"& CheckMail(i)
		End if
		If BMail="" Then
			BMail = CheckMail(i)
		Else
			BMail = BMail & "|"& CheckMail(i)
		End if
	Next
	X1=" <A href=Reg.asp>注册协议</a> "
	tmp = Replace(Team.ElseHtml (1),"{$wensurl}",team.MenuTitle)
	tmp = Replace(tmp,"{$SessionID}",Session.SessionID)
	tmp = Replace(tmp,"{$regs}",iif(Cid(team.Forum_setting(48))>=1,"","display:none"))
	tmp = Replace(tmp,"{$censedemail}",Replace(team.Club_Class(23),Chr(13)&Chr(10),"|"))
	tmp = Replace(tmp,"{$doublee}",team.Forum_setting(6))
	tmp = Replace(tmp,"{$CName}",CName)
	tmp = Replace(tmp,"{$cMail}",cMail)
	tmp = Replace(tmp,"{$bMail}",bMail)
	tmp = Replace(tmp,"{$BName}",Replace(BName,"*",".*"))
	Echo tmp
End Sub

Sub callreg
	Dim i,Code,UserGroupID,UserInfo,ExtCredits,MustOpen
	Dim username,password,password2,email,questionid,answer,UserMail
	Dim usersex,birthday,City,site,qq,Icq,yahoo,msn,taobao,alipay,Sign,Levelname
	If Request.Form("formhash")<>Session.Sessionid then
		team.Error "您提交的参数错误,请重新返回刷新后再试 "
	End If
	'判断同一IP注册间隔时间
	If Not Isnull(Session("regtime")) Or CID(team.Forum_setting(10)) > 0 Then
		If DateDiff("s",Session("regtime"),Now()) < CID(team.Forum_setting(10)) Then
			team.Error "系统设置了同一个IP在 "&team.Forum_setting(10)&" 秒内只能注册一次,请误重复提交!"
			Exit Sub
		End If
	End If
	If team.Forum_setting(48)>=1 Then
		Code = Request.Form("seccodeverify")
		if Not Team.CodeIsTrue(Code) Then
			team.Error " 验证码错误,请刷新后重新填写 "
		End If
	End If
	UserName = team.Checkstr(Trim(Request.Form("username")))
	Password = team.Checkstr(Trim(Request.Form("password")))
	Password2 = team.Checkstr(Trim(Request.Form("password2")))
	If UserName = "" or IsNull(UserName) Then
		team.error "用户名不能为空 !"
	End If
	If Not IstrueName(UserName) Then 
		team.Error " 您的用户名有错误的字符。 "
	End if
	UserMail = HtmlEncode(Request.Form("email"))
	If Not IsValidEmail(UserMail) Then
		team.error2 "邮件格式错误 !"
	End If
	If Password <> Password2 Then
		team.error2 "两次输入的密码不相同,请重新输入! "
	End If
	Questionid = team.Checkstr(Trim(Request.Form("questionid")))
	Answer = team.Checkstr(Trim(Request.Form("answer")))
	If Questionid<>"" and Not IsNull(Questionid) Then
		If Answer="" then team.Error  "你设置了安全提问，请填写必要的答案选项。"
	End If
	If team.Forum_setting(7)>=1 Then
		UserGroupID = 5
		Levelname="未激活用户||||||0||0"
	Else
		UserGroupID = 27
		Levelname="附小一年级||||||0||0"
	End If
	If Not team.execute("Select * From ["&Isforum&"User] Where UserName='"&UserName&"'").Eof Then
		team.Error " 用户名重复，请重新输入一个用户名。"
	End If
	Dim Mybirthday
	If Len(Request.Form("birthday"))>4 Then
		If Not IsDate(Request.Form("birthday")) Then
			team.Error "生日必须为日期格式"
		Else
			Mybirthday = HtmlEncode(Request.Form("birthday"))
		End If
	Else
		Mybirthday = ""
	End if
	UserInfo = team.Checkstr( Request.Form("qq") &"|"& Request.Form("Icq") &"|"& Request.Form("yahoo") &"|"& Request.Form("msn") &"|"& Request.Form("taobao") &"|"& Request.Form("alipay") )
	ExtCredits= Split(team.Club_Class(21),"|")
	team.Execute( "insert into ["&Isforum&"User] (UserName,Userpass,UserGroupID,Members,Levelname,RegIP,Usermail,Userhome,UserCity,Question,Answer,Birthday,UserSex,Newmessage,Posttopic,Postrevert,Deltopic,Goodtopic,Regtime,Landtime,Postblog,UserInfo,Extcredits0,Extcredits1,Extcredits2,Extcredits3,Extcredits4,Extcredits5,Extcredits6,Extcredits7,UserUp) values('"&username&"','"&MD5(Password,16)&"',"&UserGroupID&",'注册用户','"&Levelname&"','"&Remoteaddr&"','"&UserMail&"','"&HtmlEncode(Request.Form("site"))&"','"&HtmlEncode(Request.Form("usercity"))&"','"&Questionid&"','"&Answer&"','"& Mybirthday &"',"&CID(Request.Form("usersex"))&",0,0,0,0,0,"&SqlNowString&","&SqlNowString&",0,'"&UserInfo&"',"&Cid(Split(ExtCredits(0),",")(2))&","&Cid(Split(ExtCredits(1),",")(2))&","&Cid(Split(ExtCredits(2),",")(2))&","&Cid(Split(ExtCredits(3),",")(2))&","&Cid(Split(ExtCredits(4),",")(2))&","&Cid(Split(ExtCredits(5),",")(2))&","&Cid(Split(ExtCredits(6),",")(2))&","&Cid(Split(ExtCredits(7),",")(2))&",'0|"&Now&"')" )
	Dim AdRs,SQL,RegNum
	'用户短信
	If team.Forum_setting(15) = 1 Then
		Set AdRs= team.execute("Select Top 1 UserName From ["&Isforum&"User] Where UserGroupID = 1")
		If Not (adRs.Eof And AdRs.Bof) Then
			SQL = "insert into ["&Isforum&"Message] (author,incept,content,Sendtime,MsgTopic) values ('"&Adrs(0)&"','"&UserName&"','"&team.Forum_setting(16)&"',"&SqlNowString&",'注册系统消息')"
			team.Execute(SQL)
			team.execute("Update ["&Isforum&"User] set Newmessage=Newmessage+1 where UserName='"&UserName&"'")
		End If
		AdRs.close:Set AdRs=Nothing
	End If
	'更新最后注册用户
	team.execute("Update ["&Isforum&"Clubconfig] Set Newreguser='"&UserName&"',UserNum=UserNum+1")
	Application(CacheName&"_UserNum") = Application(CacheName&"_UserNum")+1
	Cache.DelCache("Club_Class")
	Session(CacheName&"_UserLogin") =""
	'发送邮件通知/邮件激活
	RegNum = team.Createpass()
	Dim CallUser,LoginNums,Rs
	Select Case CID(team.Forum_setting(7))
		Case 1
			team.execute("Update ["&Isforum&"User] set RegNum='"&RegNum &"' where UserName='"&UserName&"'")
			Dim Mailtopic,Body
			Mailtopic="用户名注册成功"
			Body=""&vbCrlf&"亲爱的"&username&", 您好!"&vbCrlf&""&vbCrlf&"恭喜! 您已经成功地注册了您的资料, 非常感谢您使用"&team.Club_Class(3)&"的服务!"&vbCrlf&""&vbCrlf&"　* 您的帐号是:"&username&"　密码是:"&password&""&vbCrlf&""&vbCrlf&"　* "&team.Club_Class(1)&"("&team.Club_Class(2)&"Default.asp)"&vbCrlf&""&vbCrlf&" 请点击下面的链接激活您的用户信息 "&vbCrlf&" <a href="&team.Club_Class(2)&"/GetUserReg.asp?getname="&UserName&"getid="& RegNum &">　* 最后, 有几点注意事项请您牢记"&vbCrlf&"1、请遵守《计算机信息网络国际联网安全保护管理办法》里的一切规定。"&vbCrlf&"2、使用轻松而健康的话题，所以请不要涉及政治、宗教等敏感话题。"&vbCrlf&"3、承担一切因您的行为而直接或间接导致的民事或刑事法律责任。"&vbCrlf&""&vbCrlf&""&vbCrlf&"论坛服务由 "&team.Club_Class(1)&"("&team.Club_Class(2)&") 提供　程序制作:TEAM5.CN [By Daymoon]"&vbCrlf&""&vbCrlf&""&vbCrlf&""
			Call Emailto(UserMail,Mailtopic,Body)
			CallUser = "<li>注册信息已经发送到您注册的邮箱地址,请点击信息码激活您的用户信息 ! "
		Case 2
			CallUser = "<li>用户名注册成功,请等待管理员审核您的申请!  "
		Case Else
			CallUser = "<li>用户名：<font color=red>"&Username&"</font><li>密码：<font color=red>"&Password&"</font> "
			'判断Cookies更新目录
			Dim cookies_path_s,cookies_path_d,cookies_path
			cookies_path_s=split(Request.ServerVariables("PATH_INFO"),"/")
			cookies_path_d=ubound(cookies_path_s)
			cookies_path="/"
			For i=1 to cookies_path_d-1
				cookies_path=cookies_path&cookies_path_s(i)&"/"
			Next
			LoginNums = team.Createpass()
			Response.Cookies(Forum_sn)("username")=CodeCookie(username)
			Response.Cookies(Forum_sn)("userpass")=md5(password,16)
			Response.Cookies(Forum_sn)("LoginNum") = LoginNums
			Set Rs=team.execute("Select Max(ID) From ["&IsForum&"User]")
			If Not Rs.Eof Then
				Response.Cookies(Forum_sn)("UserID") = Rs(0)
			End if
			Rs.Close:Set Rs=Nothing
			Response.Cookies(Forum_sn).path = cookies_path
			team.Execute("Update ["&Isforum&"User] Set LoginNum='"&LoginNums&"' Where UserName='"&UserName&"'")
	End Select
	Session("regtime")=now()
	CallUser = CallUser & "<li>注册新用户资料成功<li><a href=Default.asp>返回论坛首页</a>"
	team.error1 CallUser & "<meta http-equiv=refresh content=3;url=Default.asp>"
End Sub
Team.Footer
%>