📄 control.asp

📁 一个asp写的论坛源代码,论坛所需要的功能都有
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<!-- #include file="conn.asp" -->
<!-- #include file="INC/Const.asp" -->
<!-- #include file="inc/MD5.asp" -->
<%
Dim x1,x2,fID
team.Headers(Team.Club_Class(1) &" - 控制面板")
testUser()
Select Case Request("action")
	Case "usercp"
		Call UserCp
	Case "edituserinfo"
		Call Edituserinfo
	Case "bank"
		Call UserBank
	Case "edituserbank"
		Call edituserbank
	Case "friend"
		Call UserFriend
	Case "edituserfriend"
		Call edituserfriend
	Case "delfriend"
		Call delfriend
	Case "buyuserbank"
		Call buyuserbank
	Case "subscription"
		Call Subscription
	Case Else
		Call Main()
End Select
team.Footer()

Sub Subscription
	Echo "未开发功能"
End Sub

Sub edituserfriend
	Dim newfriend,myFriend,Rs
	Newfriend = HtmlEncode(Request("newfriend"))
	myFriend = ""
	If team.execute("Select UserName From ["&Isforum&"User] Where UserName='"&Newfriend&"'").Eof Then
		team.error " 系统不存在 "&Newfriend&" 此用户。"
	Elseif Trim(TK_UserName) = Trim(Newfriend) Then
		team.error "您不能添加自己为好友。"
	Else
		Set Rs = team.execute("Select Friend From ["&Isforum&"User] where ID="& team.TK_UserID)
		If Not Rs.Eof Then
			myFriend = RS(0) & Newfriend & "|"
		End if
		Rs.Close:Set Rs=Nothing
		team.execute("Update ["&IsForum&"User] Set Friend='"&myFriend&"' where ID="& team.TK_UserID)
		Session(CacheName&"_UserLogin") = ""
	End if
	team.error1 " <li> 好友添加成功，现在将自动返回。<li> <a href=""Control.asp?action=friend"">返回控制面板首页</a>。 <meta http-equiv=refresh content=3;url=""Control.asp?action=friend"">"	
End Sub

Sub delfriend
	Dim Rs,myFriend,ByName
	ByName= HRF(2,1,"byname")
	myFriend = ""
	Set Rs = team.execute("Select Friend From ["&Isforum&"User] where ID="& team.TK_UserID)
	If Not Rs.Eof Then
		myFriend = Replace(Rs(0),ByName&"|","")
	End if
	Rs.Close:Set Rs=Nothing
	team.execute("Update ["&IsForum&"User] Set Friend='"&myFriend&"' where ID="& team.TK_UserID)
	Session(CacheName&"_UserLogin") = ""
	team.error1 " <li> 好友删除成功，现在将自动返回。<li> <a href=""Control.asp?action=friend"">返回控制面板首页</a>。 <meta http-equiv=refresh content=3;url=""Control.asp?action=friend"">"	
End Sub

Sub UserFriend
	Dim tmp,Rs,Ms,Ump,UserInfo,UserMedals,Emp,ExtCredits
	x2 = "<a href=""Control.asp""> 控制面板 </a>"
	x1 = " 好友列表 "
	ExtCredits = Split(team.Club_Class(21),"|")
	tmp = Replace(Team.UserHtml (1),"{$weburl}",team.MenuTitle)
	tmp = iHtmlEncode(BlackTmp(HtmlEncode(tmp),"friends"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"uersinfo"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"usercp"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"userbank"))
	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,Friend 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,"{$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,"{$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,"{$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
	Dim Friend,Fmp
	If Len(Ump(29))<2 Then
		tmp = Replace(tmp,"{$isfriends}","")
	Else
		If Instr(Ump(29),"|")>0 Then
			Fmp = Split(Ump(29),"|")
			for i = 0 to Ubound(Fmp)-1
				If Fmp(i) <> "" Then
					Friend = Friend & "<tr class=""tab4""><td> NO."&i+1&" </td><td> "&Fmp(i)&" </td><td> <a href=""msg.asp?action=sendpm&byname="&Fmp(i)&"""> <img src="""&team.styleurl&"/sendpm.gif"" align=""absmiddle"" border=""0"" alt=""发送短信""></a> &nbsp; <a href=""?action=delfriend&byname="&Fmp(i)&"""> <img src="""&team.styleurl&"/delete.gif"" align=""absmiddle"" border=""0"" alt=""删除此好友""></a></td></tr>"
				End if
			Next
		Else
			Friend = "<tr class=""tab4""><td> NO.1 </td><td> "&Ump(29)&" </td><td> <a href=""msg.asp?action=sendpm&byname="&Ump(29)&"""> <img src="""&team.styleurl&"/sendpm.gif"" align=""absmiddle"" border=""0"" alt=""发送短信""></a> &nbsp; <a href=""?action=delfriend&byname="&Ump(29)&"""> <img src="""&team.styleurl&"/delete.gif"" align=""absmiddle"" border=""0"" alt=""删除此好友""></a></td></tr>"
		End if
		tmp = Replace(tmp,"{$isfriends}",Friend)
	End if
	Echo tmp
End Sub

Sub buyuserbank
	Dim buys
	buys = HRF(1,2,"buys")
	If team.Forum_setting(102) = "" Or Len(team.Forum_setting(102))<7 Then
		team.error " 系统为开通积分兑换。"
	Else
		If Buys < CID(team.Forum_setting(105)) Then
			team.error " 购买额度小于系统限制 [最少"&CID(team.Forum_setting(105))&"]，交易被取消。"
		Else
			If DateDiff("s",Request.Cookies("times")("buytime"),Now()) < 120 Then
				team.error " 每次购买时间不能少于120秒 "
			Else
				team.Execute("insert into ["&Isforum&"BankLog] (bankname,buyname,buyvalue,getvalue,posttime,Makes) values ('"&Replace(Replace(Replace(now(),":","")," ",""),"-","")&team.TK_UserID&"','"&tk_UserName&"',"&CID(buys/team.Forum_setting(104))&","&buys&","&SqlNowString&",0)")
				Response.Redirect "API/Payto.asp?price="&buys
				team.error1 " <li> 购买成功，请等待系统管理员审核，现在将自动返回。<li> <a href=""Control.asp?action=usercp"">返回控制面板首页</a>。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
				Response.Cookies("times")("buytime") = Now()
			End if
		End if
	End if
End Sub

Sub edituserbank
	Dim toname,Rs,Rs1,rewardprice,Userrewardprice,ExtCredits
	ExtCredits = Split(team.Club_Class(21),"|")
	toname = HRF(1,1,"toname")
	rewardprice = HRF(1,2,"rewardprice")
	Userrewardprice = rewardprice * ( 1 + team.Forum_setting(11) )
	If CID(rewardprice) < Cid(team.Forum_setting(12)) Then
		team.error "转账额低，无法完成交易。"
	End if
	Set Rs = team.execute("Select * From ["&Isforum&"User] Where UserName='"&toname&"'")
	If Rs.Eof Then
		team.Error " 系统不存在此用户。 "
	Else
		Set Rs1 = team.execute("Select Extcredits"&Cid(team.Forum_setting(99))&" From ["&Isforum&"User] Where UserName='"&TK_UserName&"'")
		If Not Rs.Eof Then
			If CID(Rs1(0)) <= CID(Userrewardprice) Then 
				team.error " 您的余额不够，不能转账。"
			Else
				team.execute("Update ["&Isforum&"User] Set Extcredits"&Cid(team.Forum_setting(99))&"=Extcredits"&Cid(team.Forum_setting(99))&"-"&CID(Userrewardprice)&" Where UserName='"&TK_UserName&"'")
				team.execute("Update ["&Isforum&"User] Set Extcredits"&Cid(team.Forum_setting(99))&"=Extcredits"&Cid(team.Forum_setting(99))&"+"&CID(rewardprice)&",Newmessage=Newmessage+1 Where UserName='"&toname&"'")
				team.Execute("insert into ["&Isforum&"Message] (author,incept,content,Sendtime,MsgTopic,isbak) values ('"&TK_UserName&"','"&toname&"','恭喜您，用户"&tk_UserName&"转账了"&rewardprice&"点的"&Split(ExtCredits(Cid(team.Forum_setting(99))),",")(0)&"到您的帐户，请登陆到<a href=""Control.asp?action=bank"">积分转账管理</a>，查看您的积分余额。',"&SqlNowString&",'积分转账通知',0)")
				team.error1 " <li> 转账成功，请等待系统自动返回。<li> <a href=""Control.asp?action=usercp"">返回控制面板首页</a>。 <meta http-equiv=refresh content=3;url=""Control.asp?action=usercp"">"
			End if
		End if
		Rs1.Close:Set Rs1 = Nothing
	End if
	Rs.Close:Set Rs = Nothing
End Sub

Sub UserBank
	Dim tmp,Rs,Ms,Ump,UserInfo,UserMedals,Emp,ExtCredits
	x2 = "<a href=""Control.asp""> 控制面板</a>"
	x1 = " 用户"&TK_UserName&" "
	ExtCredits = Split(team.Club_Class(21),"|")
	tmp = Replace(Team.UserHtml (1),"{$weburl}",team.MenuTitle)
	tmp = iHtmlEncode(BlackTmp(HtmlEncode(tmp),"userbank"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"uersinfo"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"usercp"))
	tmp = iHtmlEncode(TempCode(HtmlEncode(tmp),"friends"))
	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,"{$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,"{$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,"{$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,"{$forumride}",team.Forum_setting(11))
	tmp = Replace(tmp,"{$minpower}",Cid(team.Forum_setting(12)))
	tmp = Replace(tmp,"{$nowbanks}",IIF(Split(ExtCredits(Cid(team.Forum_setting(99))),",")(3)=1,  " ( "& Split(ExtCredits(Cid(team.Forum_setting(99))),",")(0)&" ) "," (本积分未启用) "))
	tmp = Replace(tmp,"{$mybanks}",Ump(20+Cid(team.Forum_setting(99))) &"  "&Split(ExtCredits(Cid(team.Forum_setting(99))),",")(1))
	tmp = Replace(tmp,"{$buyrate}",CID(team.Forum_setting(104)))
	tmp = Replace(tmp,"{$minbuys}",CID(team.Forum_setting(105)))
	tmp = Replace(tmp,"{$isbuybank}",IIF(team.Forum_setting(102) = "" Or Len(team.Forum_setting(102))<7,"Display:none",""))
	Echo tmp
End Sub

Sub Edituserinfo
	Dim tmp
	team.ChkPost()
	If strLength(HRF(1,1,"sign"))>CID(team.Group_Browse(23)) or strLength(HRF(1,1,"sign"))>255 Then
		team.error "签名长度不能大于 "&team.Group_Browse(23)&" 或最大255字符 ，请返回修改。"
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -