manage.asp

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

						Call delpiont(RS(0))
						temp="解除主题置顶成功。"
						GInfo = "解除置顶"
					End if
				End if
				If request.form("togoodtopic")=1 and team.Group_Manage(8) = 1 Then
					If Rs(3) = 0 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)&"'")
						Mstemp = Mstemp & "<br>用户"&tk_UserName&"将主题[<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]加入精华区。"
					End if
				ElseIf request.form("togoodtopic")=2 and team.Group_Manage(8) = 1 Then
					If Rs(3) = 1 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)&"'")
						Mstemp = Mstemp & "<br>用户"&tk_UserName&"将主题[<a href=Thread.asp?tid="&RS(1)&">"&RS(2)&"</a>]移出精华区。"
					End if
				End If
				Call Pmsetto(rs(0),Rs(2))
			End if
			Rs.Close:Set Rs=Nothing
		next
	Else
		Team.Error "您所在的组 "&team.Levelname(0)&" 没有加入/解除精华主题的权限"
	End if
	Call Serverend(Mstemp)
End Sub

Sub isclosepages
	Dim ho,rs
	If team.Group_Manage(7) = 1 then
		for each ho in request.form("ismanages")
			set rs=team.execute("Select username,topic from ["&IsForum&"forum] where id="&ho)
			If Not Rs.BOF then
				If request.form("isclose")=0 Then
					Team.execute("update ["&IsForum&"forum] set CloseTopic=1 where id="&ho)
					Mstemp = "关闭主题  [url=Thread.asp?tid="&ho&"]"&RS(1)&"[/url] "
					Call delpiont(RS(0))
					GInfo = "关闭主题"
					Call Pmsetto(rs(0),rs(1))
					temp="关闭主题成功"
				Else
					Team.execute("update ["&IsForum&"forum] set CloseTopic=0 where id="&ho)
					temp="打开被关闭的主题成功"
					Mstemp =  "打开被关闭主题  [url=Thread.asp?tid="&ho&"]"&RS(1)&"[/url]"
					Call delpiont(RS(0))
					GInfo = "打开关闭主题"
					Call Pmsetto(rs(0),Rs(1))
				End if
			End if
			Rs.Close:Set Rs=Nothing
		next
	Else
		Team.Error("<li>您所在的组 "&team.Levelname(0)&" 没有关闭/打开主题的权限")
	End if
	Call Serverend(Mstemp)
End Sub

Sub movenews
	Dim ho
	If team.Group_Manage(5) = 1 then
		for each ho in request.form("ismanages")
			team.execute("update ["&IsForum&"forum] set Lasttime="&SqlNowString&" Where id="&ho)
			temp="拉前主题成功"
			Mstemp =  "拉前主题"
		next
	Else
		Team.Error "您所在的组 "&team.Levelname(0)&" 没有拉前主题的权限"
	End if
	Call Serverend(Mstemp)
End Sub

Sub islockpages
	Dim ho,rs,RName
	If team.Group_Manage(6) = 1 then
		for each ho in request.form("ismanages")
			If request.form("isclose")=0 Then
				if isnumeric(Request("rid")) and Request("rid")<>"" and (Request.Form("fismanage")="" or not isnumeric(Request.Form("fismanage"))) then
					set rs=team.execute("Select ReList,username,Topic from ["&IsForum&"forum] where id="&Request("rid"))
					If Not Rs.BOF then
						team.execute("update ["&IsForum & rs(0)&"] set lock=1 where topicid="&Request("rid")&" and id="&ho)
						RName = team.execute("select username from ["&IsForum & rs(0)&"] where id="&ho)(0)
						Mstemp =  "锁定回贴"
						Call delpiont(RName)
						GInfo = "锁贴"
						Call Pmsetto(RName,RS(2))
						Temp="锁定回贴成功。"
					end if
					Rs.Close:Set Rs=Nothing
				else
					set rs=team.execute("Select username,topic from ["&IsForum&"forum] where id="&ho)
					If Not Rs.BOF then
						team.execute("update ["&IsForum&"forum] set Locktopic = 1 where id="&ho)
						Mstemp =  "锁定主题 [url=Thread.asp?tid="&ho&"]"&RS(1)&"[/url]"
						Call delpiont(RS(0))
						GInfo = "锁贴"
						Call Pmsetto(RS(0),RS(1))
					End If
					Rs.Close:Set Rs=Nothing
					Temp="锁定主题成功。"
				end if
			Else
				if isnumeric(Request("rid")) and Request("rid")<>"" then
					set rs=team.execute("Select ReList,username,Topic from ["&IsForum&"forum] where id="&Request("rid"))
					If Not Rs.BOF then
						team.execute("update ["&IsForum & rs(0)&"] set lock=0 where topicid="&Request("rid")&" and id="&ho)
						Mstemp =  "解除回贴锁定"
						GInfo = "锁贴"
						Call delpiont(team.execute("select username from ["&IsForum & rs(0)&"] where id="&ho)(0))
						Call Pmsetto(team.execute("select username from ["&IsForum & rs(0)&"] where id="&ho)(0),RS(2))
						Temp="解除回贴锁定成功。"
					end If
					Rs.Close:Set Rs=Nothing
				else
					set rs=team.execute("Select username,Topic from ["&IsForum&"forum] where id="&ho)
					If Not Rs.BOF then
						team.execute("update ["&IsForum&"forum] set Locktopic =0 where id="&ho)
						Mstemp =  "解除主题锁定"
						Call delpiont(RS(0))
						GInfo = "锁贴"
						Call Pmsetto(RS(0),RS(1))
					End If
					Rs.Close:Set Rs=Nothing
					Temp="解除主题锁定成功。"
				end if
			End If
		next
		Application.Contents.RemoveAll()
	Else
		Team.Error "您所在的组 "&team.Levelname(0)&" 没有锁定/解除帖子的权限"
	End if
	Call Serverend(Mstemp)
End Sub

Sub forummove()
	Dim Ts,UpID,ho,Rs,SQL
	Dim Board_Setting
	if team.Group_Manage(4) = 1 then
		if Request("moveid")="" then 
			team.Error "您没有选择要将主题移动哪个论坛!"
		End if
		If Request("moveid")=Request("fid") Then 
			team.Error "你选择的论坛和源论坛相同!"
		End If
		Board_Setting = team.Execute("Select Board_Setting From ["&IsForum&"bbsconfig] where ID="&Request("moveid"))(0)
		if Split(Board_Setting,"$$$")(2) = 1 Then
			team.Error "目标论坛属于审核版块，不能转入。"
		End if
		for each ho in request.form("ismanages")
			Set Rs = team.execute("Select forumid,topic,Toptopic,Locktopic,Lasttime,UserName,ID from ["&IsForum&"forum] where id="&ho)
			If Not (Rs.BOF and Rs.EOF) Then
				team.execute("Update ["&IsForum&"forum] set forumid="&int(Request("moveid"))&",topic='"&RS(1)&"',Toptopic=0,Locktopic=0,Lasttime="&SqlNowString&"  Where ID="&ho)
				GInfo = "移动主题"
				Call delpiont(RS(5))
				Call Pmsetto(RS(5),Rs(1))
				Mstemp = "移动帖子ID : [url=Thread.asp?tid="&RS(6)&"]"&RS(1)&"[/url][BR]"
			End If
			Temp="移动主题成功"
			Rs.Close:Set Rs=Nothing
			UpID = Team.Execute("Select Max(ID) From ["&IsForum&"Forum] Where deltopic=0 and forumid="& Request("fid"))(0)
			set Ts=team.execute("select top 1 topic,Lasttime,username,ID from ["&IsForum&"forum] where ID="& UpID )
			If Not Ts.Eof Then
				team.execute("update ["&IsForum&"bbsconfig] set Board_Last='<A href=Thread.asp?tid="&TS(3)&" target=""_blank"">"&Cutstr(TS(0),200)&"</a> →$@$"&TK_UserName&"$@$"&Now()&"' where id="&Request("fid"))
			End If
			Ts.Close:Set Ts=Nothing
		Next
		Cache.DelCache("BoardLists")
	Else
		team.Error " 您所在的组 "&team.Levelname(0)&" 没有移动主题的权限 "
	End if
	Call Serverend(Mstemp)
End Sub

Sub deltopics
	if team.Group_Manage(3) = 1 then
		Dim Forum_ID,Max_ID,rs1,ho,rs,Isnames,DayDel
		for each ho in request.form("ismanages")
			if Request("rid")<>"" and isnumeric(Request("rid")) And (Request.Form("fismanage")="" or not isnumeric(Request.Form("fismanage"))) then
				set rs=team.execute("Select forumid,ReList,Topic,Posttime from ["&IsForum&"forum] where id="&Request("rid"))
				If Not Rs.BOF then
					Isnames= team.execute("select username from ["&IsForum & rs(1)&"] where id="&ho)(0)
					Call delpiont(Isnames)
					GInfo = "删除回贴"
					Call Pmsetto(Isnames,RS(2))
					KillUpdateUserpostExc Isnames,1
					team.execute("delete from ["&IsForum & rs(1)&"] where id="&ho)
					team.execute("update ["&IsForum&"forum] set replies=replies-1 where id="&Request("rid"))
					If DateDiff("d",RS(3),Date())=0 Then
						DayDel = "today=today-1,"
					End If
					team.execute("update ["&IsForum&"bbsconfig] set "& DayDel &"tolrestore=tolrestore-1 where id="&rs(0))
					team.execute("update ["&IsForum&"user] set postrevert=postrevert-1 where username='"&Isnames&"'")
				End If
				Temp="删除回贴成功"
				Mstemp = "删除回贴"
				Rs.close:Set Rs=Nothing
			Else
				'If Request.Form("fismanage")<>"" And IsNumeric(Request.Form("fismanage")) Then
					'set rs=team.execute("Select forumid,topic,toptopic,goodtopic,Locktopic,lasttime,UserName,id,ReList from ["&IsForum&"forum] where id="& Int(Request.Form("fismanage")))
				'Else
					set rs=team.execute("Select forumid,topic,toptopic,goodtopic,Locktopic,lasttime,UserName,id,ReList from ["&IsForum&"forum] where id="&ho)
				'End if
				If Not Rs.BOF then
					team.execute("update ["&IsForum&"user] set deltopic=deltopic+1 where username='"&rs(7)&"'")
					team.execute("update ["&IsForum&"forum] set toptopic=0,deltopic=1,lasttime="&SqlNowString&" where deltopic=0 and id="&ho)
					'处理其他表
					team.execute("delete from ["&IsForum &"FVote] where RootID="&ho)
					team.execute("delete from ["&Isforum&"Activity] where RootID="&ho)
					team.execute("delete from ["&Isforum&"ReActivity] where RootID="&ho)
					team.execute("delete from ["&Isforum&"ActivityUser] where RootID="&ho)
					If DateDiff("d",RS(3),Date())=0 Then
						DayDel = "today=today-1,"
					End If
					Max_ID=Team.Execute("Select Max(ID) from ["&IsForum&"forum] where deltopic=0 and Forumid="&rs(0))(0)
					If Max_ID<>"" Then
						Set Rs1=Team.Execute("Select ID,topic,username,posttime from ["&IsForum&"forum] where deltopic=0 and id="&Max_ID)
						if Not rs1.eof then
							team.execute("update ["&IsForum&"bbsconfig] set "&DayDel&"toltopic=toltopic-1,Board_Last='<A href=Thread.asp?tid="&rs1(0)&" target=""_blank"">"&Cutstr(rs1(1),200)&"</a> →$@$"&TK_UserName&"$@$"&Now()&"' where id="&rs(0))
						End If
						Rs1.Close:Set Rs1 = Nothing
					Else
						team.execute("update ["&IsForum&"bbsconfig] set "&DayDel&"toltopic=toltopic-1,Board_Last='暂无帖子$@$"&TK_UserName&"$@$"&Now()&"' where id="&rs(0))
					End If
					Call delpiont(RS(6))
					GInfo = "删除主题"
					Call Pmsetto(RS(6),RS(1))
					KillUpdateUserpostExc RS(6),0
				End If
				Temp = "删除主题成功"
				Mstemp =  "删除主题"
			End If
		Next
		Cache.DelCache("BoardLists")
	Else
		Team.Error "您所在的组 "&team.Levelname(0)&" 没有删除帖子的权限"
	End if
	Call Serverend(Mstemp)
End Sub

Sub Serverend(s)
	team.SaveLOG("用户"&TK_UserName&"操作: "&s)
	team.Error1 ("<li>"&temp&"<li><a href=""Forums.asp?fid="&request("fid")&""">返回论坛</a><li><a href=""Default.asp"">返回论坛首页</a><meta http-equiv=refresh content=3;url=""Forums.asp?fid="&request("fid")&""">")
End Sub

Sub delpiont(s)
	Dim ExtCredits,m,ExtSort,GetMyExs,ExcName
	If HRF(1,2,"douser") = 0 Then Exit Sub
	ExtCredits = Split(team.Club_Class(21),"|")
	For m = 0 To UBound(ExtCredits)
		ExtSort=Split(ExtCredits(M),",")
		If Split(ExtCredits(M),",")(3)=1 Then
			If Request.Form("ExtCredits"&M) <> "0" Then
				If GetMyExs = "" Then
					GetMyExs = "ExtCredits"& M& "=ExtCredits"& M& "+"& Request.Form("ExtCredits"&M)
				Else
					GetMyExs = GetMyExs & ",ExtCredits"& M& "=" & "ExtCredits"& M& "+ "& Request.Form("ExtCredits"&M)
				End If
				ExcName = ExcName & ExtSort(0) &" : "& Request.Form("ExtCredits"&M)
			End If
		End If
	Next
	If GetMyExs <>"" Then
		if s=TK_UserName then 
			team.Error "你不能对自己进行操作!"
		Else
			team.execute("Update ["&IsForum&"User] Set "& GetMyExs &" Where UserName='"&s&"' ")
		End If
		temp = temp & "<br>" & ExcName
	End if
End Sub
Sub Pmsetto(s,m)
	If request("sendpm") = "1" Then 
		Dim Istemp,ho
		If Not team.IsMaster and len(request("reason"))<2 Then 
			team.error2 "你没有填写操作原因"
		Else
			Istemp = "这是由论坛系统自动发送的通知短消息。[br] "
			If request("rid")<>"" or isnumeric(Request("rid")) Then 
				Istemp = Istemp & " 您在主题：[url=Thread.asp?tid="&request("rid")&"]"&m&"[/url] 的回复帖子 [br] "
			Else
				Istemp = Istemp & " 您所发表的主题： "
				for each ho in request.form("ismanages")
					Istemp = Istemp & "  [url=Thread.asp?tid="&ho&"] "&m&"[/url] [br]"
				Next
			End if
			Istemp = Istemp & " 被 "&tk_UserName&" 执行 "& GInfo  &" 操作 [br] 操作理由:  "&request("reason")&" 。"
		End If
		Team.Execute("insert into ["&IsForum&"message](author,incept,content,Sendtime,MsgTopic) values ('"&TK_UserName&"','"&s&"','"&Istemp&"',"&SqlNowString&",'[系统消息]您发表的帖子被执行管理操作!')")
		Team.Execute("update ["&IsForum&"user] set newmessage=newmessage+1 where username='"&s&"'")
	End If
End Sub

Sub ManageClass()
	Dim Rs
	team.ChkPost()
	Set Rs = team.Execute("Select ID,bbsname From ["&IsForum&"bbsconfig] Where ID="&fID)
	If Rs.Eof Then
		team.Error " 参数错误。"
	Else
		Values = Rs.GetRows(-1)
	End If
	team.Headers("论坛帖子管理中心 - "& Values(1,0))
	x1="<a href=""Forums.asp?fid="&fID&""">"& Values(1,0)  &"</a> "
	x2=" 论坛帖子管理中心 "
	Echo team.MenuTitle
	If Not team.UserLoginED Then
		team.Error " 你未登陆论坛。<meta http-equiv=refresh content=3;url=login.asp> "
	End if
	If Not team.ManageUser Then
		team.Error " 您的权限不够，不能参与论坛管理 。"
	Else
		If Not team.IsMaster and Not team.SuperMaster Then
			If team.execute("Select ManageUser from ["&Isforum&"Moderators] Where BoardID = "& fid).eof Then 
				team.Error " 您不是此版的版主,不能参与此版的管理"
			End If
		End if
	End if
End Sub
Team.footer
%>