gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\announcements.asp

    <!--#include file="Conn.asp"-->
<!-- #include file="inc/const.asp" -->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/dv_ubbcode.asp"-->
<!--#include file="inc/ubblist.asp"-->
<%
Mybbs.LoadTemplates("postjob")
Dim abgcolor
Dim canpostann,caneditann
Dim canmodifyusername
Dim username
Dim rs,sql
canpostann=false
caneditann=false
canmodifyusername=false
Mybbs.stats=Template.Strings(10)
Mybbs.ShowErr()
Dim dv_ubb
Dim EmotPath
EmotPath=Split(Mybbs.Forum_emot,"|||")(0)		'em心情路径
Set dv_ubb=new Dvbbs_UbbCode
If Request("action")<>"showone" Then
	Mybbs.Nav()
	If Mybbs.Boardid=0 then
		Mybbs.Head_var 0,0,"",""
		'把版主权限去掉，这样版主就在首页就发不了公告了。
		Mybbs.boardmaster=False
	Else
		Mybbs.head_var 1,Mybbs.Board_Data(4,0),"",""
	End if
Else
	Mybbs.head()
	Response.Write "<br>"
End If
If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(25))=1 Then
	canpostann=True
Else
	canpostann=False
End If
If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(25))=1 Then
	canpostann=True
ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(25))=0 Then
	canpostann=False 
End If
If (Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster) and Cint(Mybbs.GroupSetting(26))=1 Then
	caneditann=True 
Else
	caneditann=False
End If
If Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(26))=1 Then
	caneditann=true
ElseIf Mybbs.FoundUserPer and Cint(Mybbs.GroupSetting(26))=0 Then
	caneditann=false
End If
If canpostann or caneditann Then
	response.write Replace(Template.Strings(11),"{$boardid}",Mybbs.boardid)
End If
If request("action")="AddAnn" Then
	Call addann()
ElseIf request("action")="SaveAnn" Then
	Call saveann()
ElseIf request("action")="EditAnn" Then 
	Call editann()
ElseIf request("action")="EditAnnInfo" Then
	Call EditAnnInfo()
ElseIf request("action")="SaveEdit" Then
	Call SaveEdit()
ElseIf request("action")="delann" Then
	Call delann()
Else
	Call main()
end if
Mybbs.ShowErr()
Mybbs.activeonline()
Set dv_ubb=Nothing
Mybbs.Footer()

Sub main()
	Dim Tempwrite,i
	Response.Write Replace(Template.Strings(12),"{$boardid}",Mybbs.boardid)
	If Request("action")="showone" Then
		sql="select top 1 title,content,username,addtime,bgs from Dv_bbsnews where boardid="&Mybbs.BoardID&" order by id desc"
	Else
		sql="select title,content,username,addtime,bgs from Dv_bbsnews where boardid="&Mybbs.BoardID&" order by id desc"
	End If
	
	Set rs=Mybbs.execute(sql)
	If rs.eof and rs.bof then
		Tempwrite=Template.html(8)
		Tempwrite=Replace(Tempwrite,"{$title}",Template.Strings(13))
		Tempwrite=Replace(Tempwrite,"{$content}",Template.Strings(14))
		Tempwrite=Replace(Tempwrite,"{$username}",Template.Strings(15))
		Tempwrite=Replace(Tempwrite,"{$addtime}",Now())
		Tempwrite=Replace(Tempwrite,"{$bgs}","No")
		Response.Write Tempwrite
	Else
		Sql=Rs.GetRows(-1)
		For i=0 to Ubound(sql,2)
			Tempwrite=Tempwrite&Template.html(8)
			Tempwrite=Replace(Tempwrite,"{$title}",Dv_FilterJS(Sql(0,i)))
			ubblists=ubblist(Sql(1,i))&"39,"
			Tempwrite=Replace(Tempwrite,"{$content}",dv_ubb.Dv_UbbCode(Sql(1,i),Mybbs.UserGroupID,2,1))
			Tempwrite=Replace(Tempwrite,"{$username}",Mybbs.HtmlEnCode(Sql(2,i)))
			REM 修正显示公告时间为NULL值时出错 2004-6-1 Dv.Yz
			If Isdate(Sql(3,i)) Then
				Tempwrite=Replace(Tempwrite,"{$addtime}",Sql(3,i))
			Else
				Tempwrite=Replace(Tempwrite,"{$addtime}",Now())
			End If
			If Sql(4,i)="" or Isnull(Sql(4,i)) then
				Tempwrite=Replace(Tempwrite,"{$bgs}","No")
			Else
				If Request("action")="showone" Then
					Tempwrite=Replace(Tempwrite,"{$bgs}","<img src=Skins/Default/filetype/mid.gif border=0><bgsound src="&Sql(4,i)&" border=0>")
				Else
					Tempwrite=Replace(Tempwrite,"{$bgs}","Yes")
				End if
			End if
		Next
		Response.Write Tempwrite
	End if
	Rs.close:set rs=nothing
End Sub

Sub AddAnn()
	Dim Tempwrite,Boardlist,Readme,i
	If not canpostann then
		Mybbs.AddErrCode(28)
		Exit sub
	End if
	Sql="select boardid,boardtype from Dv_board"
	Set rs=Mybbs.execute(sql)
	If Rs.eof and Rs.bof Then
		Boardlist=""
	Else
		Sql=Rs.GetRows(-1)
		For i=0 to Ubound(Sql,2)
			Boardlist=Boardlist&"<option value='"&Sql(0,i)&"'"
			If Mybbs.BoardID=Clng(Sql(0,i)) then Boardlist=Boardlist&" selected "
			Boardlist=Boardlist&">"&Sql(1,i)&"</option>"
		Next
	End if
	Rs.close:Set rs=nothing
	If Mybbs.boardmaster Then
		Readme=""
	Else
		Readme=Template.Strings(16)
	End if
	Tempwrite=Template.html(9)
	Tempwrite=Replace(Tempwrite,"{$username}",Mybbs.membername)
	Tempwrite=Replace(Tempwrite,"{$boardlist}",Boardlist)
	Tempwrite=Replace(Tempwrite,"{$readme}",Readme)
	Tempwrite=Replace(Tempwrite,"{$title}","")
	Tempwrite=Replace(Tempwrite,"{$content}","")
	Tempwrite=Replace(Tempwrite,"{$action}","?action=SaveAnn")
	Tempwrite=Replace(Tempwrite,"{$dowhat}",Template.Strings(23))
	Tempwrite=Replace(Tempwrite,"{$bgs}","")
	Response.Write Tempwrite
End sub

Sub SaveAnn()
	If not Canpostann then
		Mybbs.AddErrCode(28)
		Exit sub
	End if
	Dim username,title,content,bgs
	If request("username")="" then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(17)&"&action=OtherErr"
	Else
		username=Mybbs.CheckStr(request("username"))
	End if
	If request("title")="" then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(18)&"&action=OtherErr"
	Else
		title=Mybbs.CheckStr(request("title"))
	End if
	If request("content")="" then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(19)&"&action=OtherErr"
	Else
		content=Mybbs.CheckStr(request("content"))
	End If
	bgs=Dv_FilterJS(request("bgs"))

	Set rs=server.createobject("adodb.recordset")
	Sql="select * from Dv_bbsnews"
	If Not IsObject(Conn) Then ConnectionDatabase
	rs.open sql,conn,1,3
	rs.addnew
	rs("username")=fixjs(username)
	rs("title")=fixjs(title)
	rs("content")=content
	rs("addtime")=Now()
	rs("boardid")=Mybbs.BoardID
	rs("bgs")=bgs
	rs.update
	rs.close:Set rs=Nothing
	If Mybbs.BoardID>0 Then 
		Mybbs.Name = "BoardInfo_" & Mybbs.BoardID
		Mybbs.LoadBoardNews_Paper(Mybbs.BoardID)
	Else
		Mybbs.DelCahe "news"&Mybbs.boardid
	End If
	Mybbs.Dvbbs_suc("<li>"&Template.Strings(20))
End sub

Sub EditAnn()
	Dim Tempwrite,Newslist,i
	If not caneditann then
		Mybbs.AddErrCode(28)
		Exit sub
	End if
	If Mybbs.BoardID=0 then
		Set rs=Mybbs.execute("select id,boardid,title,username,addtime,bgs from Dv_bbsnews order by addtime desc")
	Else
		Set rs=Mybbs.execute("select id,boardid,title,username,addtime,bgs from Dv_bbsnews where boardid="&Mybbs.BoardID&" order by addtime desc")
	End if
	If Rs.eof and Rs.bof Then
		Newslist=Template.Strings(21)
	Else
		Sql=Rs.GetRows(-1)
		For i=0 To Ubound(Sql,2)
			'修复以往公告的错误。
			If isnull(Sql(1,i)) Then Mybbs.execute("update Dv_bbsnews set boardid=0 where boardid is null")
			Newslist=Newslist&Template.html(11)
			Newslist=Replace(Newslist,"{$boardid}",Sql(1,i)&"")
			Newslist=Replace(Newslist,"{$id}",Sql(0,i))
			Newslist=Replace(Newslist,"{$title}",Dv_FilterJS(Sql(2,i)))
			Newslist=Replace(Newslist,"{$username}",Mybbs.HtmlEnCode(Sql(3,i)))
			REM 修正显示公告时间为NULL值时出错 2004-6-1 Dv.Yz
			If Isdate(Sql(4,i)) Then
				Newslist=Replace(Newslist,"{$addtime}",Sql(4,i))
			Else
				Newslist=Replace(Newslist,"{$addtime}",Now())
			End If
			Newslist=Replace(Newslist,"{$bgs}",Dv_FilterJS(Sql(5,i)))
		Next
	End if
	Rs.close:set rs=nothing
	Tempwrite=Template.html(10)
	Tempwrite=Replace(Tempwrite,"{$boardid}",Mybbs.Boardid)
	Tempwrite=Replace(Tempwrite,"{$newslist}",Newslist)
	Response.Write Tempwrite
End sub

Sub EditAnnInfo()
	Dim Tempwrite,Boardlist,Readme,i
	dim trs,newsid,title,content,bgs
	If not caneditann then
		Mybbs.AddErrCode(28)
		Exit sub
	End if
	If not isnumeric(request("id")) then
		Mybbs.AddErrCode(42)
		Exit sub
	Else
		newsid=Clng(request("id"))
	End if
	Sql="select boardid,boardtype from Dv_board"
	Set rs=Mybbs.execute(sql)
	If Rs.eof and Rs.bof Then
		Boardlist=""
	Else
		Sql=Rs.GetRows(-1)
		For i=0 to Ubound(Sql,2)
			Boardlist=Boardlist&"<option value='"&Sql(0,i)&"'"
			If Mybbs.BoardID=Clng(Sql(0,i)) then Boardlist=Boardlist&" selected "
			Boardlist=Boardlist&">"&Sql(1,i)&"</option>"
		Next
	End if
	Rs.close:Set rs=nothing
	If Mybbs.boardmaster Then
		Readme=""
	Else
		Readme=Template.Strings(16)
	End if
	Set rs=Mybbs.execute("select title,content,bgs from Dv_bbsnews where id="&newsid)
	If rs.eof and rs.bof then
		title=""
		content=""
		bgs=""
	Else
		title=rs(0)
		content=rs(1)
		bgs=rs(2)
	End if
	Tempwrite=Template.html(9)
	Tempwrite=Replace(Tempwrite,"{$username}",Mybbs.membername)
	Tempwrite=Replace(Tempwrite,"{$boardlist}",Boardlist)
	Tempwrite=Replace(Tempwrite,"{$readme}",Readme)
	Tempwrite=Replace(Tempwrite,"{$title}",Dv_FilterJS(title))
	Tempwrite=Replace(Tempwrite,"{$content}",Dv_FilterJS(content))
	Tempwrite=Replace(Tempwrite,"{$action}","?action=SaveEdit&id="&newsid)
	Tempwrite=Replace(Tempwrite,"{$dowhat}",Template.Strings(24))
	Tempwrite=Replace(Tempwrite,"{$bgs}",Dv_FilterJS(bgs))
	Response.Write Tempwrite
End sub

Sub SaveEdit()
	If not caneditann then
		Mybbs.AddErrCode(28)
		Exit sub
	End if
	Dim username,title,content,bgs
	If not isnumeric(request("id")) then
		Mybbs.AddErrCode(42)
		Exit sub
	End if
	If request("username")="" then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(17)&"&action=OtherErr"
	Else
		username=Mybbs.CheckStr(request("username"))
	End if
	If request("title")="" then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(18)&"&action=OtherErr"
	Else
		title=Mybbs.CheckStr(request("title"))
	End if
	If request("content")="" then
		Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(19)&"&action=OtherErr"
	Else
		content=Mybbs.CheckStr(request("content"))
	End if
	bgs=Dv_FilterJS(request("bgs"))
	Set rs=server.createobject("adodb.recordset")
	Sql="select * from Dv_bbsnews where id="&cstr(request("id"))
	If Not IsObject(Conn) Then ConnectionDatabase
	rs.open sql,conn,1,3
	rs("username")=fixjs(username)
	rs("title")=fixjs(title)
	rs("content")=content
	rs("addtime")=Now()
	rs("boardid")=Mybbs.BoardID
	rs("bgs")=bgs
	rs.update
	rs.close
	Set Rs=Nothing
	If Mybbs.BoardID>0 Then 
		Mybbs.Name = "BoardInfo_" & Mybbs.BoardID
		Mybbs.LoadBoardNews_Paper(Mybbs.BoardID)
	Else
		Mybbs.DelCahe "news"&Mybbs.boardid
	End If
	
	Mybbs.Dvbbs_suc("<li>"&Template.Strings(25))
End sub

Sub delann()
	If not caneditann then
		Mybbs.AddErrCode(28)
		Exit sub
	End if
	Dim delid,fixid
	delid=replace(request.form("id"),"'","")
	delid=replace(delid,";","")
	delid=replace(delid,"--","")
	delid=replace(delid,")","")
	fixid=replace(delid," ","")
	fixid=replace(fixid,",","")
	If Not IsNumeric(fixid) Then
		Mybbs.AddErrCode(42)
		Exit Sub
	End If
	Mybbs.execute("delete from Dv_bbsnews where id in ("&delid&")")
	Mybbs.Dvbbs_suc("<li>"&Template.Strings(22))
	ReloadAnnouncement_All
End sub

Function ReloadAnnouncement_All
	Dim trs,i
	Set tRs=Mybbs.execute("select boardid from [Dv_board]")
	If Not (tRs.eof and tRs.bof) then
		Sql=tRs.GetRows(-1)
		For i=0 To Ubound(Sql,2)
			Mybbs.Name = "BoardInfo_" & Sql(0,i)
			Mybbs.LoadBoardNews_Paper(Sql(0,i))
		Next
	End if
	tRs.close:Set trs=nothing
End Function

Function fixjs(Str)
	If Str <>"" Then
		str = replace(str,"\", "\\")
		Str = replace(str, chr(34), "\""")
		Str = replace(str, chr(39),"\'")
		Str = Replace(str, chr(13), "\n")
		Str = Replace(str, chr(10), "\r")
		str = replace(str,"'", "&#39;")
	End If
	fixjs=Str
End Function
Function enfixjs(Str)
	If Str <>"" Then
		Str = replace(str,"&#39;", "'")
		Str = replace(str,"\""" , chr(34))
		Str = replace(str, "\'",chr(39))
		Str = Replace(str, "\r", chr(10))
		Str = Replace(str, "\n", chr(13))
		Str = replace(str,"\\", "\")
	End If
	enfixjs=Str
End Function
Function Dv_FilterJS(v)
	If Not Isnull(V) Then
		Dim t
		Dim re
		Dim reContent
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		re.Pattern="(&#)"
		t=re.Replace(v,"<I>&#</I>")
		re.Pattern="(script)"
		t=re.Replace(t,"<I>script</I>")
		re.Pattern="(js:)"
		t=re.Replace(t,"<I>js:</I>")
		re.Pattern="(value)"
		t=re.Replace(t,"<I>value</I>")
		re.Pattern="(about:)"
		t=re.Replace(t,"<I>about:</I>")
		re.Pattern="(file:)"
		t=re.Replace(t,"<I>file:</I>")
		re.Pattern="(Document.cookie)"
		t=re.Replace(t,"<I>Documents.cookie</I>")
		re.Pattern="(vbs:)"
		t=re.Replace(t,"<I>vbs:</I>")
		re.Pattern="(on(mouse|Exit|error|click|key))"
		t=re.Replace(t,"<I>on$2</I>")
		Dv_FilterJS=t
		Set Re=Nothing
	End If 
End Function
%>
<script language="javascript">
function CheckAll(form)  
  {  
  for (var i=0;i<form.elements.length;i++)  
    {  
    var e = form.elements[i];  
    if (e.name != 'chkall')  
       e.checked = form.chkall.checked;  
    }  
  }  
</script>