repot.asp

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

<!-- #include file="conn.asp" -->
<!-- #include file="INC/Const.asp" -->
<%
Dim tID,retopicid,x1,x2,fid
tID = HRF(2,2,"tid")
Retopicid = HRF(2,2,"retopicid")
TestUser()
If HRF(2,1,"action") = "repot" Or HRF(2,1,"action") = "repotok" Then
	team.Headers(Team.Club_Class(1) & " - 报告帖子")
Else
	team.Headers(Team.Club_Class(1) & " - 参与评分")
End if
Select Case HRF(2,1,"action")
	Case "repot"
		Call repot
	Case "repotok"
		Call repotok
	Case "upext"
		Call upext
End Select
team.footer

Sub upext
	Dim Rs,nUser,ReList,Topic,Posttime,i
	Set Rs = team.execute("Select topic,ReList,UserName,Posttime From ["&IsForum&"Forum] Where deltopic=0 and CloseTopic=0 and ID="& tID )
	If Rs.Eof And Rs.Bof Then
		team.Error "指定的帖子不存在或已经被删除。"
	Else	
		Topic = RS(0)
		ReList = Rs(1)
		nUser = Rs(2)
		Posttime = Rs(3)
	End If
	Rs.close:Set Rs = Nothing
	If Retopicid > 0 Then
		Set Rs = team.execute("Select UserName,Posttime From ["&IsForum & ReList &"] Where ID="& retopicid)
		If Rs.Eof And Rs.Bof Then
			team.Error "指定的回帖不存在或已经被删除。"
		Else
			nUser = Rs(0)
			If Int(team.Forum_setting(60))>0 Then
				If DateDiff("h",Rs(1),Now())>team.Forum_setting(60) Then 
					team.Error "此帖子发表的时候超过"&team.Forum_setting(60)&"小时，无法进行评分操作。"
				End If
			End if
		End If
	Else
		If Int(team.Forum_setting(60))>0 Then
			If DateDiff("h",Posttime,Now())>team.Forum_setting(60) Then 
				team.Error "此帖子发表的时候超过"&team.Forum_setting(60)&"小时，无法进行评分操作。"
			End If
		End if
	End If
	x1 = "参与评分"
	x2 = "<a href=""Thread.asp?tid="&tid & IIF(Retopicid>0,"#"&Retopicid&"","")&""">"&Topic&"</a>"
	Echo team.MenuTitle
	Echo "<form method=""post"" action=""?action=upextok""><table border=""0"" cellspacing=""1"" cellpadding=""3"" width=""80%"" align=""center"" class=""a2"">"
	Echo "<tr class=""tab1""><td colspan=""2""> 参与评分 </td></tr>"
	Echo "<tr class=""a4""><td>评分用名：</td><td>" & tk_UserName & " </td></tr>"
	Echo "<tr class=""a4""><td>作  者：</td><td>" & nUser & " </td></tr>"
	Echo "<tr class=""a4""><td>标  题：</td><td>" & Topic & " </td></tr>"
	Echo "<tr class=""a4""><td>评  分：</td><td> <select onchange=""this.form.score.value=this.value"" style=""width: 8em"">"
	Dim ExtCredits,ExtSort
	ExtCredits= Split(team.Club_Class(21),"|")
	ExtSort=Split(ExtCredits(team.Forum_setting(46)),",")
	Echo "<option value=""0"">"& ExtSort(0) &"</option>"
	For i = -5 To 5
		Echo "<option value="""&I&""">"&I&"</option>"
	Next
	Echo "</select><input type=""text"" name=""score"" value=""0"" size=""3""> </td></tr>"
	Echo "<tr class=""a4""><td valign=""top"">操作原因：<BR>您必须输入理由才能进行操作<BR><BR><input type=""checkbox"" name=""sendreasonpm"" value=""1"" checked disabled> 发短消息通知作者</td><td><textarea name=""reason"" style=""height: 8em; width: 25em""></textarea></td></tr>"
	Echo "</table><br><center><input type=""submit"" name=""ratesubmit"" value=""提 &nbsp; 交""></center></form>"
End Sub

Sub repotok
	Dim Rs,rUser,ReList,Topic,nTitle,nUser,i
	If Request.Form("postname") = "" Then
		team.Error "您没有选定需要报告的管理人员"
	End if
	rUser = Split(HtmlEncode(Replace(Request.Form("postname")," ","")),",")
	Set Rs = team.execute("Select topic,ReList,UserName From ["&IsForum&"Forum] Where deltopic=0 and CloseTopic=0 and ID="& tID )
	If Rs.Eof And Rs.Bof Then
		team.Error "指定的帖子不存在或已经被删除。"
	Else	
		Topic = RS(0)
		ReList = Rs(1)
		nUser = Rs(2)
	End If
	Rs.close:Set Rs = Nothing
	nTitle = ""
	If retopicid > 0 Then
		Set Rs = team.execute("Select ID,UserName From ["&IsForum & ReList &"] Where ID="& retopicid)
		If Rs.Eof Then
			team.Error "指定的回帖不存在或已经被删除。"
		Else
			nTitle = "帖子链接：<a href=""Thread.asp?tid="&tid&"#"&retopicid&""" target=""_blank"">"& Topic &" </a><BR>回复用户：<a href=""Profile.asp?username="&Rs(1)&""">"&RS(1)&"</a>"
		End If
		Rs.close:Set Rs = Nothing
	Else
		nTitle = "帖子链接：<a href=""Thread.asp?tid="&tid&""" target=""_blank"">"& Topic &" </a><BR>发表用户：<a href=""Profile.asp?username="&nUser&""">"&nUser&"</a>"
	End if
	For i=0 To Ubound(rUser)
		If Not (Trim(tk_UserName) = Trim(rUser(i))) Then
			team.Execute("insert into ["&Isforum&"Message] (author,incept,content,Sendtime,MsgTopic) values ('"&tk_UserName&"','"&rUser(i)&"','你好：我发现以下链接的帖子不符合论坛管理要求，希望您可以处理下。<BR> "&nTitle&"',"&SqlNowString&",'问题帖子报告')")
			team.execute("Update ["&Isforum&"User] set Newmessage=Newmessage+1 where UserName='"&rUser(i)&"'")
		End if
	Next
	team.error1 "<li>帖子报告成功。</li><li> <a href=Thread.asp?tid="& tID &">返回主题</a><li><a href=""Default.asp"">返回论坛首页</a><meta http-equiv=refresh content=3;url=Thread.asp?tid="& tID & ">"
End Sub

Sub repot
	Dim Rs,tWhere
	If team.Forum_setting(63)=0 Then
		team.Error "系统暂时关闭了报告帖子的功能。请向管理员发送站内短信查询。"
	End If
	Echo "<table border=""0"" cellspacing=""1"" cellpadding=""3"" width=""80%"" align=""center"" class=""a2"">"
	Echo "<tr class=""tab1""><td> TEAM's提示 </td></tr>"
	Echo "<tr class=""a4""><td> <B>帖子报告</B> ：请在下列管理用户里面选取您需要报告的管理人员，然后在点击“下一步”，进行帖子报告的操作。 </td></tr>"
	Echo "</table><br>"
	Echo "<form method=""Post"" action=""?action=repotok&tid="&tid&"&retopicid="&retopicid&"""><table border=""0"" cellspacing=""1"" cellpadding=""3"" width=""80%"" align=""center"" class=""a2"">"
	Echo "<tr class=""tab1""><td width=""10%""> 选取 </td><td width=""50%""> 管理人员名称 </td><td width=""40%""> 用户等级 </td></tr>"
	If team.Forum_setting(63)= 1 Then
		tWhere = "UserGroupID=3"
	ElseIf team.Forum_setting(63)= 2 Then
		tWhere = "UserGroupID=3 or UserGroupID=2"
	ElseIf team.Forum_setting(63)= 3 Then
		tWhere = "UserGroupID=3 or UserGroupID=2 or UserGroupID=1"
	End if
	Set Rs = team.execute("Select UserName,Levelname From ["&IsForum&"User] Where "& tWhere &" Order By UserGroupID Asc")
	Do While Not Rs.Eof
		Echo "<tr class=""tab4""><td><input type=""checkbox"" name=""postname"" class=""radio"" value="""&Rs(0)&"""></td><td><a href=""Profile.asp?username="&Rs(0)&""">"&Rs(0)&"</a></td><td> "& Split(RS(1),"||")(0) &"  </td></tr>"
		Rs.MoveNext
	Loop
	Rs.close:Set Rs = Nothing
	Echo "</table><br><center><input type=""submit"" name=""submit"" value=""下一步""></center><br></form>"
	
End Sub

%>