control.asp

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

	End if
	If HRF(1,1,"qq")<>"" Then
		If Not IsNumeric(HRF(1,1,"qq")) Then
			team.error " QQ 格式错误。 "
		End if
	End if
	If HRF(1,1,"icq")<>"" Then
		If Not IsNumEric(HRF(1,1,"icq")) Then
			team.error " ICQ 格式错误。"
		End if
	End if
	Dim Brithday,SQL,Questionid,Answer
	Brithday = HRF(1,1,"birthday")
	If Brithday <>"" Then
		If Not IsDate(trim(Brithday)) Then Brithday = ""
	End If
	If Len(HRF(1,1,"oldpassword"))> 1 Then
		If Len(HRF(1,1,"oldpassword"))<3 Then 
			team.Error "您需要输入正确的原始密码才可以修改登陆密码和邮箱地址"
		Else
			If MD5(Trim(HRF(1,1,"oldpassword")),16) <> Trim(team.User_SysTem(1)) Then
				team.error1 "<li> 用户密码错误，请等待系统返回后重新输入 。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
			Else
				If Trim(HRF(1,1,"newpassword")) <> Trim(HRF(1,1,"newpassword2")) Then
					team.error1 "<li> 两次输入的用户密码不相同，请等待系统返回后重新输入 。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
				Else
					If Trim(HRF(1,1,"newpassword"))<>"" And Trim(HRF(1,1,"newpassword2"))<>"" Then
						SQL = "UserPass='"&MD5(HRF(1,1,"newpassword"),16)&"',"
						tmp = tmp & "<li> 密码修改成功 。 "
						Response.Cookies(Forum_sn)("username")=""
						Response.Cookies(Forum_sn)("userpass")=""
						Response.Cookies(Forum_sn)("UserMember")=""
						Response.Cookies(Forum_sn)("UserID")="0"
						Session("UserMember")= ""
						Session("Admin_Pass")=""
					End if
				End if
				Questionid = HRF(1,1,"questionid")
				Answer = HRF(1,1,"answer")
				If Questionid<>"" Then
					If Answer= "" Then 
						team.error1 " 你设置了安全提问选项，必须填写完整的回答选项，请等待系统返回后重新输入 。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
					End if
					Questionid = ""
					Answer = ""
				Else
					If Answer<> "" Then 
						team.error1 " 你未设置安全提问选项，请等待系统返回后重新输入 。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
					End if
					Questionid = ""
					Answer = ""
				End if
				team.execute("Update ["&IsForum&"User] Set "&SQL&" Usermail='"&HRF(1,1,"emailnew")&"',Question='"&Questionid&"',Answer='"&Answer&"' where ID="& team.TK_UserID)
			End If
		End if
	End If
	Dim TSign
	TSign = HRF(1,1,"sign")
	If team.Group_Browse(21) = 0 Then
		TSign = Replace(TSign,"[","［")
	End If
	If team.Group_Browse(22) = 0 Then
		If InStr(TSign,"[img]")>0 Or InStr(TSign,"[IMG]")>0 Then
			team.Error "签名不支持[img]表情"
		End If
	End If 
	team.execute("Update ["&IsForum&"User] Set Userhome='"&HRF(1,1,"userhome")&"',Userface='"&HRF(1,1,"urlavatar")&"',UserCity='"&HRF(1,1,"usercity")&"',UserSex='"&HRF(1,2,"usersex")&"',Honor='"&HRF(1,1,"honor")&"',Birthday='"&Brithday&"',Sign='"&TSign&"',UserInfo='"&HRF(1,1,"qq")&"|"&HRF(1,1,"icq")&"|"&HRF(1,1,"yahoo")&"|"&HRF(1,1,"msn")&"|"&HRF(1,1,"taobao")&"|"&HRF(1,1,"alipay")&"' where ID="& team.TK_UserID)
	If HRF(1,1,"tppnew") <>"" OR HRF(1,1,"pppnew")<>"" OR HRF(1,1,"msgsound")<>"" Then
		If HRF(1,1,"msgsound") <>"" Then
			Response.Cookies(Forum_sn)("msgsound") = HRF(1,1,"msgsound")
		End if
		If HRF(1,1,"tppnew") <>"" Then
			Response.Cookies(Forum_sn)("tppnew") = HRF(1,1,"tppnew")
		End if
		If HRF(1,1,"pppnew") <>"" Then
			Response.Cookies(Forum_sn)("pppnew") = HRF(1,1,"pppnew")
		End if
		'判断Cookies更新目录
		Dim cookies_path_s,cookies_path_d,cookies_path,i
		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
		Response.Cookies(Forum_sn).path = cookies_path
	End If
	Cache.DelCache("UserBirthdays")
	Application(CacheName&"_Nobady") = 0
	team.error1 " "&tmp&"<li> 用户资料保存成功，请等待系统自动返回。<li> <a href=""Control.asp?action=usercp"">返回控制面板首页</a>。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
End Sub

Sub UserCp
	Dim tmp,Rs,Ms,Ump,UserInfo,UserMedals,Emp
	x2 = "<a href=""Control.asp""> 控制面板</a>"
	x1 = " 用户"&TK_UserName&" "
	tmp = Replace(Team.UserHtml (1),"{$weburl}",team.MenuTitle)
	tmp = iHtmlEncode(BlackTmp(HtmlEncode(tmp),"usercp"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"uersinfo"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"userbank"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"friends"))
	tmp = Replace(tmp,"{$allface}",CID(team.Forum_setting(100)))
	Set Rs = team.execute("Select UserGroupID,Levelname,Usermail,Userhome,Userface,UserCity,UserSex,Question,Answer,Honor,Birthday,Sign,Medals,UserInfo,Posttopic,Postrevert,Deltopic,Goodtopic,Regtime,Landtime,Extcredits0,Extcredits1,Extcredits2,Extcredits3,Extcredits4,Extcredits5,Extcredits6,Extcredits7,Members From ["&Isforum&"User] where ID="& team.TK_UserID)
	If Not Rs.Eof Then
		Ms = Rs.GetString(,1, "$$##$$","","")
	End if
	Rs.Close:Set Rs=Nothing
	Ump = Split(Ms,"$$##$$")
	UserInfo = Split(Ump(13),"|")		
	'UserInfo = QQ|ICQ|YAHOO|MSN|TAOBAO|ALIPAY
	tmp = Replace(tmp,"{$usermail}",Ump(2))
	tmp = Replace(tmp,"{$userhome}",Ump(3))
	tmp = Replace(tmp,"{$userface}",Ump(4))
	tmp = Replace(tmp,"{$usercity}",Ump(5))
	tmp = Replace(tmp,"{$sex}",Ump(6))
	tmp = Replace(tmp,"{$userquest}",IIF(Ump(7)<>"","<option value="""&Ump(7)&""" checked>"&Ump(7)&"</option>",""))
	tmp = Replace(tmp,"{$answer}",Ump(8))
	tmp = Replace(tmp,"{$honor}",Ump(9))
	tmp = Replace(tmp,"{$brithday}",Ump(10))
	tmp = Replace(tmp,"{$sign}",Replace(Ump(11),"<BR>",CHR(10)))
	tmp = Replace(tmp,"{$userqq}",IIf(UserInfo(0)<>"","<a target=""_blank"" href=""tencent://message/?uin="&UserInfo(0)&"&Site=team5.cn&Menu=yes""><img border=""0"" SRC=""http://wpa.qq.com/pa?p=1:"&UserInfo(0)&":7"" alt=""点击这里给我发消息"" onerror=""javascript:this.src='images/qqerr.gif'""></a>",""))
	tmp = Replace(tmp,"{$qq}",UserInfo(0))
	tmp = Replace(tmp,"{$icq}",UserInfo(1))
	tmp = Replace(tmp,"{$yahoo}",UserInfo(2))
	tmp = Replace(tmp,"{$msn}",UserInfo(3))
	tmp = Replace(tmp,"{$taobao}",IIF(UserInfo(4)<>"","<script type=""text/javascript"">document.write('<a target=""_blank"" href=""http://amos1.taobao.com/msg.ww?v=2&amp;uid='+encodeURIComponent('"&UserInfo(4)&"')+'&amp;s=2""><img src=""http://amos1.taobao.com/online.ww?v=2&amp;uid='+encodeURIComponent('"&UserInfo(4)&"')+'&amp;s=2"" alt=""淘宝旺旺"" border=""0"" />"&UserInfo(4)&"</a> ');</script>",""))
	tmp = Replace(tmp,"{$taobao1}",UserInfo(4))
	tmp = Replace(tmp,"{$alipay}",UserInfo(5))
	If Ump(12)<>"" Then
		UserMedals = ""
		If Instr(Ump(12),"$$$")>0 Then
			Dim i
			UserMedals = Split(Ump(12),"$$$")
			For i = 0 to Ubound(UserMedals)-1
				Emp = Emp & "<img src=""images/plus/medal"&Split(UserMedals(i),"&&&")(0)&".gif"" align=""absmiddle"" alt="""&Split(UserMedals(i),"&&&")(1)&"""> "
			Next
			tmp = Replace(tmp,"{$userMedals}",Emp)
		End if
	Else
		tmp = Replace(tmp,"{$userMedals}","")
	End if
	tmp = Replace(tmp,"{$signmax}",team.Group_Browse(23))
	tmp = Replace(tmp,"{$msgsound}",IIf(Request.Cookies(Forum_Sn)("msgsound")="",1,Request.Cookies(Forum_Sn)("msgsound")))
	tmp = Replace(tmp,"{$tppnew}",IIF(Request.Cookies(Forum_Sn)("tppnew")="","<option value="""&CID(team.Forum_setting(19))&""" selected=""selected"">- 使用默认 -</option>","<option value="""&CID(Request.Cookies(Forum_Sn)("tppnew"))&""" selected=""selected"">"&CID(Request.Cookies(Forum_Sn)("tppnew"))&"</option>"))
	tmp = Replace(tmp,"{$pppnew}",IIF(Request.Cookies(Forum_Sn)("pppnew")="","<option value="""&CID(team.Forum_setting(20))&""" selected=""selected"">- 使用默认 -</option>","<option value="""&CID(Request.Cookies(Forum_Sn)("pppnew"))&""" selected=""selected"">"&CID(Request.Cookies(Forum_Sn)("pppnew"))&"</option>"))
	Echo tmp
End Sub

Sub Main()
	Dim tmp,Rs,UserInfo,Emp,Post,i,PostTmp
	x1 = "<a href=""Control.asp"">控制面板</a>"
	tmp = Replace(Team.UserHtml (1),"{$weburl}",team.MenuTitle)
	tmp = iHtmlEncode(BlackTmp(HtmlEncode(tmp),"uersinfo"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"usercp"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"userbank"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"friends"))
	tmp = Replace(tmp,"{$username}",TK_UserName)
	tmp = Replace(tmp,"{$uid}",team.TK_UserID)
	tmp = Replace(tmp,"{$myurls}",team.Club_Class(2))
	Set Rs = Team.Execute("Select Top 5 id,Author,MsgTopic,Sendtime From ["&IsForum&"Message] Where incept='"&TK_UserName&"' and isbak=0 Order By Sendtime Desc ")
	If Not Rs.Eof Then
		Post = Rs.GetRows(5)
	End If
	RS.Close:Set Rs=Nothing
	If IsArray(Post) Then
		For i=0 To Ubound(Post,2)
			PostTmp = PostTmp & "<tr class=""tab4""><td align=""left""><a href=""Msg.asp?tid="&Post(0,i)&"""  target=""_blank"">"&Post(2,i)&"</a></td><td>"&Post(1,i)&"</td><td>"&Post(3,i)&"</td></tr>"
		Next
	End If
	tmp = Replace(tmp,"{$newmsg}",PostTmp)
	Post = "" : PostTmp = ""
	Set Rs = Team.Execute("Select Top 5 id,topic,Lasttime,Views,Replies,GoodTopic From ["&IsForum&"Forum] Where Deltopic=0 And UserName='"&TK_UserName&"' Order By LastTime Desc ")
	If Not Rs.Eof Then
		Post = Rs.GetRows(5)
	End If
	RS.Close:Set Rs=Nothing
	If IsArray(Post) Then
		For i=0 To Ubound(Post,2)
			PostTmp = PostTmp & "<tr class=""tab4""><td align=""left""><a href=""thread.asp?tid="&Post(0,i)&""" target=""_blank"">"&Post(1,i)&"</a> "
			If Post(5,i) = 1 Then PostTmp = PostTmp & " <img Src="""&team.styleurl&"/f_good.gif"" align=""absmiddle"" alt=""此帖已经被加入精华区""> "
			PostTmp = PostTmp & " </td><td>"&Post(3,i)&" / "&Post(4,i)&"</td><td>"&Post(2,i)&"</td></tr>"
		Next
	End If
	tmp = Replace(tmp,"{$newtopic}",PostTmp)
	Post = "" : PostTmp = ""
	Set Rs=Team.Execute("Select DISTINCT Top 5 B.id,B.Topic,B.Lasttime,B.Views,B.Replies,U.Topicid From "&IsForum & team.Club_Class(11)&" U Inner Join ["&IsForum&"Forum] B On U.Topicid=B.ID Where U.UserName='"&TK_UserName&"' and B.Deltopic=0 Order By B.Lasttime Desc")
	If Not Rs.Eof Then
		Post = Rs.GetRows(5)
	End If
	RS.Close:Set Rs=Nothing
	If IsArray(Post) Then
		For i=0 To Ubound(Post,2)
			PostTmp = PostTmp & "<tr class=""tab4""><td align=""left""><a href=""thread.asp?tid="&Post(0,i)&""" target=""_blank"">"&Post(1,i)&"</a></td><td>"&Post(3,i)&" / "&Post(4,i)&"</td><td>"&Post(2,i)&"</td></tr>"
		Next
	End If
	tmp = Replace(tmp,"{$newretopic}",PostTmp)
	Set Rs = team.execute("Select UserGroupID,Levelname,Usermail,Userhome,Userface,UserCity,UserSex,Question,Answer,Honor,Birthday,Sign,Medals,UserInfo,Posttopic,Postrevert,Deltopic,Goodtopic,Regtime,Landtime,Extcredits0,Extcredits1,Extcredits2,Extcredits3,Extcredits4,Extcredits5,Extcredits6,Extcredits7,Members From ["&Isforum&"User] where ID="& team.TK_UserID)
	If Not Rs.Eof Then
		Ms = Rs.GetString(,1, "$$##$$","","")
	End if
	Rs.Close:Set Rs=Nothing
	Ump = Split(Ms,"$$##$$")
	UserInfo = Split(Ump(13),"|")			
	'UserInfo = QQ|ICQ|YAHOO|MSN|TAOBAO|ALIPAY
	tmp = Replace(tmp,"{$usermail}",Ump(2))
	tmp = Replace(tmp,"{$userhome}",Ump(3))
	tmp = Replace(tmp,"{$userface}",Ump(4))
	tmp = Replace(tmp,"{$usercity}",Ump(5))
	tmp = Replace(tmp,"{$sex}",Ump(6))
	tmp = Replace(tmp,"{$userquest}","<option value="""&Ump(7)&""" checked>"&Ump(7)&"</option>")
	tmp = Replace(tmp,"{$answer}",Ump(8))
	tmp = Replace(tmp,"{$honor}",Ump(9))
	tmp = Replace(tmp,"{$brithday}",Ump(10))
	tmp = Replace(tmp,"{$sign}",Ump(11))
	tmp = Replace(tmp,"{$userqq}",IIf(UserInfo(0)<>"","<a target=""_blank"" href=""tencent://message/?uin="&UserInfo(0)&"&Site=team5.cn&Menu=yes""><img border=""0"" SRC=""http://wpa.qq.com/pa?p=1:"&UserInfo(0)&":7"" alt=""点击这里给我发消息"" onerror=""javascript:this.src='images/qqerr.gif'""></a>",""))
	tmp = Replace(tmp,"{$icq}",UserInfo(1))
	tmp = Replace(tmp,"{$yahoo}",UserInfo(2))
	tmp = Replace(tmp,"{$msn}",UserInfo(3))
	tmp = Replace(tmp,"{$taobao}",IIF(UserInfo(4)<>"","<script type=""text/javascript"">document.write('<a target=""_blank"" href=""http://amos1.taobao.com/msg.ww?v=2&amp;uid='+encodeURIComponent('"&UserInfo(4)&"')+'&amp;s=2""><img src=""http://amos1.taobao.com/online.ww?v=2&amp;uid='+encodeURIComponent('"&UserInfo(4)&"')+'&amp;s=2"" alt=""淘宝旺旺"" border=""0"" />"&UserInfo(4)&"</a> ');</script>",""))
	tmp = Replace(tmp,"{$alipay}",UserInfo(5))
	If Ump(12)<>"" Then
		Dim Ms,Ump,UserMedals
		UserMedals = ""
		If Instr(Ump(12),"$$$")>0 Then
			UserMedals = Split(Ump(12),"$$$")
			For i = 0 to Ubound(UserMedals)-1
				Emp = Emp & "<img src=""images/plus/medal"&Split(UserMedals(i),"&&&")(0)&".gif"" align=""absmiddle"" alt="""&Split(UserMedals(i),"&&&")(1)&"""> "
			Next
			tmp = Replace(tmp,"{$userMedals}",Emp)
		End if
	Else
		tmp = Replace(tmp,"{$userMedals}","")
	End if
	Echo tmp
End Sub
%>