manage.asp

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

<!-- #include file="conn.asp" -->
<!-- #include file="INC/Const.asp" -->
<%
Dim fID,tID,x1,x2,rID,Mstemp,GInfo
Dim MasterMenu,Inputinfo,temp
Public Values
fID = HRF(1,2,"fid")
tID = HRF(1,2,"tid")
Call ManageClass()

Select Case Request("action")
	Case "move"
		MasterMenu="移动主题"
		Inputinfo = "moves"
		call movepage
	Case "moves"
		Call forummove
	Case "deltopic"
		MasterMenu="删除帖子"
		Inputinfo = "deltopics"
		Call movepage
	Case "deltopics"
		Call deltopics
	case "movenew"
		MasterMenu="拉前主题"
		Inputinfo = "movenews"
		call movepage
	case "movenews"
		call movenews
	Case "islockpage"
		MasterMenu="锁定/解除锁定帖子"
		Inputinfo = "islockpages"
		call movepage
	Case "islockpages"
		islockpages
	Case "isclosepage"
		MasterMenu="关闭/打开主题"
		Inputinfo = "isclosepages"
		call movepage
	Case "isclosepages"
		isclosepages
	case "settops"
		MasterMenu="置顶/解除置顶"
		Inputinfo = "settopss"
		call movepage
	case "settopss"
		call settopss
	Case "digest"
		MasterMenu="加入/解除精华"
		Inputinfo = "digests"
		call movepage	
	Case "iskillofget"
		MasterMenu="奖励/惩罚"
		Inputinfo = "iskillofget"
		call movepage
	Case "digests"
		Call digests
	Case Else
		team.Error "参数错误!"
End Select	

Sub movepage 
	If request.form("ismanage")="" and request.form("fismanage")="" Then 
		team.Error("您没有选择主题或相应的管理操作，请返回修改。")
	End If
	Echo "<form method=""post"" action=""?action="&Inputinfo&""">"
	Echo "<input type=""hidden"" value="""&fID&""" name=""fid"">"
	Echo "<input type=""hidden"" value="""&Request("rid")&""" name=""rid"">"
	Echo "<input type=""hidden"" value="""&Request("fismanage")&""" name=""fismanage"">"
	Echo "<table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""3"" align=""center"" class=""a2"">"
	Echo " <tr>"
	Echo "		<td class=""a1"" colspan=""2"">TEAM's提示: "&MasterMenu&"</td>"
	Echo " </tr>"
	Echo " <tr class=""a4"">"
	Echo "		<td width=""40%""><B>用户名</B>:</td><td>"&TK_UserName&"</td>"
	Echo "</tr>"
	If Request("action")="settops" Then
		Echo "<tr class=""a4"">"
		Echo "	<td>操作:</td>"
		Echo "	<td><input type=""radio"" name=""isclose"" value=""0"" class=""radio"" checked> 置顶帖子 &nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;  "
		Echo "	<input type=""radio"" name=""isclose"" value=""1"" class=""radio""> 解除置顶 "
		Echo "	</td>"
		Echo "</tr>	 "
		Echo "<tr class=""a4"">"
		Echo "	<td>模式:</td>"
		Echo "	<td><input type=""radio"" name=""istohead"" value=""1"" class=""radio"" checked> 本版置顶 &nbsp; &nbsp; <input type=""radio"" name=""istohead"" value=""2"" class=""radio""> 总置顶 "
		Echo "</td>"
		Echo "</tr> "
	End If
	If Request("action")="settops" or Request("action")="digest" Then 
		Echo "<tr class=a4>"
		Echo "	<td>后续操作:</td>"
		Echo "	<td>"
		Echo "	<input type=""radio"" name=""togoodtopic"" value=""1"" class=""radio""> 加为精华帖子 &nbsp; &nbsp; "
		Echo "	<input type=""radio"" name=""togoodtopic"" value=""2"" class=""radio""> 解除精华"
		Echo "</td>"
		Echo "</tr>"
	End If
	If Request("action")="isclosepage" Then
		Echo "<tr class=""a4"">"
		Echo "	<td>操作:</td>"
		Echo "	<td><input type=""radio"" name=""isclose"" value=""0"" class=""radio"" checked>  关闭主题 &nbsp; &nbsp; "
		Echo "	<input type=""radio"" name=""isclose"" value=""1"" class=""radio""> 打开主题"
		Echo "	</td>"
		Echo "</tr> "
	End If
	If Request("action")="islockpage" Then
		Echo "<tr class=""a4""> "
		Echo "		<td>操作:</td> "
		Echo "	<td><input type=""radio"" name=""isclose"" value=""0"" class=""radio"" checked> 锁定帖子 &nbsp; &nbsp; "
		Echo "	<input type=""radio"" name=""isclose"" value=""1"" class=""radio""> 解除锁定帖子"
		Echo "	</td>"
		Echo "</tr>"
	End If
	If Request("action")="move" Then
		Echo " <tr class=""a4""> "
		Echo "		<td>目标论坛/分类:</td><td>"
		Echo "		<select name=moveid> "
		Echo "		<option selected value="""">将主题移动到...</option>"
		Echo			team.BBs_Value_List(0,0)
		Echo "		</Select></td> "
		Echo " </tr>"
	End if
	Echo "<tr class=""a4"">"
	Echo "<td><B>操作原因:</B><BR> 版主及以下等级进行管理必须填写操作原因，超版以上等级可以无需填写操作原因。<BR> "
	If Not team.IsMaster Then Echo " <B>您必填填写才可以进行管理操作。</B> "
	Echo " <br><input type=""checkbox"" name=""sendpm"" value=""1"" class=""radio"" "
	If request("action")="movenew" Then 
		Echo "disabled"
	End  If
	If Not team.IsMaster Then
		Echo " checked "
	End if
	Echo "> 发短消息通知作者"
	Echo "</td><td>"
	Echo "<select name=""selectreason"" size=""6"" style=""height: 8em; width: 8em"" onchange=""this.form.reason.value=this.value"">"
	Echo"<option value="""">自定义</option>"
	Dim KillInfo,i
	If Instr(team.Club_Class(8),Chr(13)&Chr(10))>0 Then
		KillInfo = Split(team.Club_Class(8),Chr(13)&Chr(10))
		For i = 0 To Ubound(KillInfo)
			Echo "<option value="""&KillInfo(i)&""">"&KillInfo(i)&"</option>"
		Next
	Else
		Echo "<option value="""&team.Club_Class(8)&""">"&team.Club_Class(8)&"</option>"
	End if	
	Echo " </select> "
	Echo " <textarea name=""reason"" style=""height: 8em; width: 18em""></textarea></td>"
	Echo " </tr>"
	if Request("action")<>"movenew" Then
		Echo "<tr class=a4>"
		Echo "<td><B>用户操作:</B><BR>将操作值设置为负数，即扣除积分，相反操作值为正数，则为加分。 </td>"
		Echo "<td>"
		Dim ExtCredits,m,ExtSort
		ExtCredits = Split(team.Club_Class(21),"|")
		For m = 0 To UBound(ExtCredits)
			ExtSort=Split(ExtCredits(M),",")
			If Split(ExtCredits(M),",")(3)=1 Then
				Echo ExtSort(0) & " <select name=""ExtCredits"&M&"""  size=""1""> "
				Call Kills
				Echo "</select> &nbsp;"
			End if
		Next
		Echo "</td>"
		Echo "</tr>"
		Echo "<tr class=a4>"
		Echo "<td><B>追加扣分:</B><BR>最佳扣分及在默认扣分的前提下，再次追加扣分数量，用于对某用户的积分进行奖罚。 </td>"
		Echo "<td><input type=""radio"" name=""douser"" value=""0"" class=""radio"" checked>默认扣分 &nbsp; <input type=""radio"" name=""douser"" value=""1"" class=""radio"">追加扣分"
		Echo "</td></tr>"
	End if
	Echo "	 </table><br /><center><input type=""submit"" value="" 确 定 ""><br /> "
	Dim Rs2,SQL2,ho,rs1
	If request("rid")="" or (Not isnumeric(Request("rid"))) Then
		Echo "<br /><table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""3"" align=""center"" class=a2><tr class=a1><td>标题</td><td>作者</td><td>回复</td><td>最后发表</td></tr>"
		for each ho in request.form("ismanage")
			Set Rs2=Team.Execute("select id,topic,UserName,Replies,Lasttime from ["&IsForum&"Forum] where id="&ho)
			If Not Rs2.Eof Then
				Echo "<tr class=a4><td><input type=checkbox name=ismanages value="&rs2(0)&" checked><a href=Thread.asp?tid="&rs2(0)&" target=_blank>"&Rs2(1)&"</a></td><td>"&Rs2(2)&"</td><td>"&Rs2(3)&"</td><td>"&Rs2(4)&"</td></tr>"
			End if
			Rs2.Close:Set Rs2=Nothing
		next
		Echo "</table></form>"
	Else
		If Request("menu")="move" and (Request.Form("fismanage")="" or not isnumeric(Request.Form("fismanage"))) Then
			team.error " 您只能对主题进行移动操作，请选定主题ID。"
		End If
		if isnumeric(Request.Form("fismanage")) and Request.Form("fismanage")<>"" Then
			Response.Write "<br /><table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""3"" align=""center"" class=a2><tr class=a1><td width=""30%"">标题</td><td width=""10%"">作者</td><td width=""10%"">回复</td><td width=""20%"">最后发表</td><td width=""10%"">用户IP</td></tr>"
			Set Rs2=Team.Execute("select id,topic,UserName,Replies,Lasttime,postip from ["&IsForum&"Forum] where id="& Request.Form("fismanage") )
			If Not Rs2.Eof Then
				Response.Write "<tr class=a4><td><input type=checkbox name=ismanages value="&rs2(0)&" checked><a href=Thread.asp?tid="&rs2(0)&" target=_blank>"&Rs2(1)&"</a></td><td>"&Rs2(2)&"</td><td>"&Rs2(3)&"</td><td>"&Rs2(4)&"</td><td>"&Rs2(5)&"</td></tr>"
			End if
			Rs2.Close:Set Rs2=Nothing
			Response.Write "</table>"
		Else
			Set Rs1=Team.Execute("select Relist,id,topic from ["&IsForum&"Forum] where id="&request("rid"))
			If Not Rs1.Eof Then
				Echo "<br /><table width=""98%"" border=""0"" cellspacing=""1"" cellpadding=""3"" align=""center"" class=a2><tr class=a1><td>主贴</td><td>回帖ID</td><td>作者</td><td>回复时间</td><td>用户IP</td></tr>"
				Echo "<input type=""hidden"" value="&Rs1(0)&" name=relistname>"
				for each ho in request.form("ismanage")
					Set Rs2=Team.Execute("select id,UserName,posttime,postip from ["&IsForum & Rs1(0)&"] where id="&ho)
					If Not Rs2.Eof Then
						Echo "<tr class=a4><td><input type=checkbox name=ismanages value="&rs2(0)&" checked> <a href=Thread.asp?tid="&rs1(1)&"#"&Rs2(0)&" target=_blank>"&Rs1(2)&"</a></td><td>"&Rs2(0)&"</a></td><td>"&Rs2(1)&"</td><td>"&Rs2(2)&"</td><td>"&Rs2(3)&"</td></tr>"
					End if
					Rs2.Close:Set Rs2=Nothing
				Next
				Echo "</table></form>"
			End If
			Rs1.Close:Set Rs1=Nothing
		End if
	End If
End Sub

Sub Kills()
	Dim i,t
	For i = -50 To -1
		t = t &"<option value="""&i&""">"&i&"</option>"
	Next
	t = t &"<option value=""0"" selected>0</option>"
	For i = 1 To 50
		t = t &"<option value="""&i&""">"&i&"</option>"
	Next
	Echo t
End Sub

Sub digests
	Dim ho,rs
	If team.Group_Manage(8) = "1" then
		for each ho in request.form("ismanages")
			set rs=team.execute("Select username,id,topic from ["&IsForum&"forum] where id="&ho)
			If Not Rs.BOF then
				If request.form("togoodtopic")=1 Then
					team.execute("update ["&IsForum&"forum] set goodtopic=1 where id="&ho)
					team.execute("update ["&IsForum&"user] set goodtopic=goodtopic+1 where username='"&RS(0)&"'")
					UpdateUserpostExc RS(0),2
					Mstemp =  "用户"&tk_UserName&"将主题[<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]加入精华区。"
					Temp = "帖子加入精华区成功 !"
					GInfo = "加精"
				ElseIf request.form("togoodtopic")=2 Then
					team.execute("update ["&IsForum&"forum] set goodtopic=0 where id="&ho)
					team.execute("update ["&IsForum&"user] set goodtopic=goodtopic-1 where username='"&RS(0)&"'")
					KillUpdateUserpostExc RS(0),2
					Mstemp = "用户"&tk_UserName&"将主题[<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]移出精华区。"
					Temp = "帖子移出精华区成功 !"
					GInfo = "取消精华"
				End If
			End if
			Call delpiont(RS(0))
			Call Pmsetto(RS(0),RS(2))
			Rs.Close:Set Rs=Nothing
		next
	Else
		Team.Error " 您所在的组 "&team.Levelname(0)&" 没有加入/解除精华主题的权限。" 
	End if
	Call Serverend(Mstemp)
End Sub

Sub KillUpdateUserpostExc(uname,m)
	'用户积分部分
	Dim ExtCredits,MustOpen,ExtSort,MustSort,UExt,u
	Dim UserPostID,My_ExtSort
	If Not team.UserLoginED Then  Exit Sub
	ExtCredits = Split(team.Club_Class(21),"|")
	MustOpen = Split(team.Club_Class(22),"|")
	For U=0 to Ubound(ExtCredits)
		ExtSort=Split(ExtCredits(U),",")
		MustSort=Split(MustOpen(U),",")
		If ExtSort(3)=1 Then
			If U = 0 Then
				UExt = UExt &"Extcredits0=Extcredits0-"&MustSort(m)&""
			Else
				UExt = UExt &",Extcredits"&U&"=Extcredits"&U&"-"&MustSort(m)&""
			End if
		End if
	Next
	team.execute("Update ["&IsForum&"User] Set "&UExt&" Where UserName = '"& HTmlEncode(uname) &"' ")
End Sub

Sub UpdateUserpostExc(uname,m)
	'用户积分部分
	Dim ExtCredits,MustOpen,ExtSort,MustSort,UExt,u
	Dim UserPostID,My_ExtSort
	If Not team.UserLoginED Then  Exit Sub
	ExtCredits = Split(team.Club_Class(21),"|")
	MustOpen = Split(team.Club_Class(22),"|")
	For U=0 to Ubound(ExtCredits)
		ExtSort=Split(ExtCredits(U),",")
		MustSort=Split(MustOpen(U),",")
		If ExtSort(3)=1 Then
			If U = 0 Then
				UExt = UExt &"Extcredits0=Extcredits0+"&MustSort(m)&""
			Else
				UExt = UExt &",Extcredits"&U&"=Extcredits"&U&"+"&MustSort(m)&""
			End if
		End if
	Next
	team.execute("Update ["&IsForum&"User] Set "&UExt&" Where UserName = '"& HTmlEncode(uname) &"' ")
End Sub

Sub settopss
	Dim ho,rs
	If team.Group_Manage(1) >= 1 then
		for each ho in request.form("ismanages")
			set rs=team.execute("Select Username,ID,Topic,Goodtopic from ["&IsForum&"forum] Where ID="&ho)
			If Not Rs.BOF then
				If request.form("isclose")=0 Then
					If request.form("istohead")=1 and team.Group_Manage(1) >= 1 Then
						team.execute("update ["&IsForum&"forum] set toptopic=1 where id="&ho)
						Mstemp = "用户"&tk_UserName&"将主题 [<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]进行了本版置顶操作。 "
						GInfo = "本版置顶"
					Elseif request.form("istohead")=2 and team.Group_Manage(1) >= 2 Then
						team.execute("update ["&IsForum&"forum] set toptopic=2 where id="&ho)
						Mstemp = "用户"&tk_UserName&"将主题 [<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]进行了总置顶操作。 "
						GInfo = "总置顶"
					End If
					Call delpiont(RS(0))
					temp="设置主题置顶成功。"
				Else
					If team.Group_Manage(1) >= 1 Then
						team.execute("update ["&IsForum&"forum] set toptopic=0 where id="&ho)
						Mstemp = "用户"&tk_UserName&"将置顶的主题 [<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]设置为正常帖子状态。"