⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 savereannounce.asp

📁 JSP ACCESS版的论坛源码 深圳盈盈通
💻 ASP
📖 第 1 页 / 共 2 页
字号:
  	       	call Error()
		else
	      	sql="update bbs1 set child=child+1,times="&cstr(announceid)&" where rootID="&cstr(rootID)
          	conn.execute(sql)
			if topic="" then
			Topic=cutStr(body,20)
			else
			Topic=cutStr(topic,20)
			end if
			sql="update board set lastpostuser='"&username&"',lastposttime='"&datetimestr&"',lastbbsnum=lastbbsnum+1,todaynum="&boardtoday(boardid)&",lastrootid="&rootid&",lasttopic='"&topic&"' where  boardid="&cstr(boardID)
			conn.execute(sql)
			conn.execute("update config set bbsnum=bbsnum+1,todayNum="&alltodays()&"")
		
			rem 主帖用户的回复帖子,看是否添加
			call haveRe()
		
			call replyemail()
			response.write "<meta http-equiv=refresh content=""3;URL=dispbbs.asp?boardid="&boardid&"&rootid="&rootid&"&id="&rootid&"&star="&request("star")&""">"
	    	call success(somerr)
	  end if
	end sub
	function boardtoday(boardid)
    	tmprs=conn.execute("Select count(announceid) from bbs1 Where year(dateandtime)=year(now()) and month(dateandtime)=month(now()) and day(dateandtime)=day(now()) and boardid="&boardid)
    	boardtoday=tmprs(0)
	set tmprs=nothing 
	if isnull(boardtoday) then boardtoday=0
	end function 
	function alltodays()
    	tmprs=conn.execute("Select count(announceid) from bbs1 Where year(dateandtime)=year(now()) and month(dateandtime)=month(now()) and day(dateandtime)=day(now())")
    	alltodays=tmprs(0)
	set tmprs=nothing
	if isnull(alltodays) then alltodays=0
	end function

	sub replyemail()
	if EmailFlag<>0 then
	on error resume next
	sql="select bbs1.EmailFlag,bbs1.username,[user].userEmail from bbs1,[user] where bbs1.username=[user].username and bbs1.announceid="&cstr(ParentID)
	rs.open sql,conn,1,1
	if not rs.eof and not rs.bof then
		if rs("EmailFlag")=1 then
			topic="您在"&ForumName&"发表的文章有人回复了"
			email=rs("userEmail")
			mailbody=mailbody & ""&rs("username")&",您好:<br>"
			mailbody=mailbody & "您在"&ForumName&"发表的文章有人回复了<br>"
			mailbody=mailbody & "请到以下地址浏览该贴子内容。<br>"
			mailbody=mailbody & "<a href="&Forumurl&"showannounce.asp?boardid="&boardid&"&rootid="&rootid&"&id="&announceid&" target=_blank>查看贴子内容</a>"
			if EmailFlag=0 then

			elseif EmailFlag=1 then
				call jmail(email)
			elseif EmailFlag=2 then
				call Cdonts(email)
			elseif EmailFlag=3 then
				call aspemail(email)
			end if
			if SendMail<>"OK" then
				somerr=somerr+"<li>"+"贴子已经成功保存,回复主题作者的Email发送失败。"
			end if
		end if
	end if
	rs.close
	end if
	end sub

	sub activeuser()
	dim rsactiveusers,activeuser
	dim membername
	dim memberword
	dim memberclass
	dim stats
	membername=request.cookies("liulang")("username")
	memberword=request.cookies("liulang")("password")
	memberclass=request.cookies("liulang")("userclass")
	stats=request.cookies("liulang")("stats")
	set rsactiveusers=server.createobject("adodb.recordset")
	activeuser="select * from online where username='"&membername&"'"
	rsactiveusers.open activeuser,conn,1,3
	if rsactiveusers.eof and rsactiveusers.bof then
	activeuser="insert into online(id,username,userclass,ip,startime,lastimebk,lastime,browser,stats) values "&_
				"("&Session.SessionID&",'"&membername&"','"&memberclass&"','"&_
				Request.ServerVariables("REMOTE_HOST")&"',now(),now(),'"&DateToStr(now())&"','"&_
				Request.ServerVariables("HTTP_USER_AGENT")&"','"&_
				boardtype&"')"
	conn.execute(activeuser)
	else
	activeuser="update online set lastimebk=now(),lastime='"&DateToStr(now())&"',stats='"&boardtype&"' where username='"&membername&"'"
	conn.execute(activeuser)
	end if
	if session("userid")<>"" then
	activeuser="delete from online where id="&cstr(session("userid"))
	Conn.Execute activeuser
	end if
	rsactiveusers.close
	set rsactiveusers=nothing
	end sub

	rem ------获得asp文件参数------
	sub getInput()
	if request("boardid")="" then
		foundError=true
		Errmsg=Errmsg+"<br>"+"<li>请指定论坛版面。"
	elseif not isInteger(request("boardid")) then
		foundError=true
		Errmsg=Errmsg+"<br>"+"<li>非法的版面参数。"
	else
		boardID=request("boardID")
	end if
	if request("followup")="" then
		foundError=true
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	elseif not isInteger(request("followup")) then
		foundError=true
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	else
		announceid=request("followup")
		ParentID=request("followup")
	end if
	if request("RootID")="" then
		foundError=true
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	elseif not isInteger(request("RootID")) then
		foundError=true
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	else
		rootID=request("RootID")
	end if
   	UserName=Checkstr(trim(request("username")))
   	UserPassWord=Checkstr(trim(request("passwd")))
	IP=Request.ServerVariables("REMOTE_ADDR") 
	Expression=Checkstr(Request.Form("Expression")&".gif")
   	Topic=Checkstr(trim(request("subject")))
   	Body=Checkstr(trim(request(session("antry"))))
	signflag=Checkstr(trim(request("signflag")))
	mailflag=Checkstr(trim(request("emailflag")))
   	boardtype=Checkstr(trim(request("boardtype")))
	end sub

	rem -----检查user输入数据的合法性------	
	function chkData()
	if signflag="yes" then
		signflag=1
	else
		signflag=0
	end if
	if mailflag="yes" then
		mailflag=1
	else
		mailflag=0
	end if

	if UserName="" or strLength(UserName)>20 then
   		ErrMsg=ErrMsg+"<Br>"+"<li>请输入姓名(长度不能大于20)"
   		foundError=True
	elseif Trim(UserPassWord)="" or strLength(UserPassWord)>10 then
   		ErrMsg=ErrMsg+"<Br>"+"<li>请输入密码(长度不能大于10)"
   		foundError=True
	end if
	if strLength(topic)>100 then
   		FoundError=True
   		if strLength(ErrMsg)=0 then
      			ErrMsg=ErrMsg+"<Br>"+"<li>主题长度不能超过100"
   		else
      			ErrMsg=ErrMsg+"<Br>"+"<li>主题长度不能超过100"
   		end if
	end if
	if request("method")="Topic" then
		if topic="" then
			if body="" then
   				ErrMsg=ErrMsg+"<Br>"+"<li>主题和内容必须填写其一。"
   				foundError=True
			end if
		end if
	end if
	if request("method")="fastreply" then
		if body="" then
   		ErrMsg=ErrMsg+"<Br>"+"<li>快速回复请填写发言内容。"
   		foundError=True
		end if
	end if
	if strLength(body)>AnnounceMaxBytes then
   		ErrMsg=ErrMsg+"<Br>"+"<li>发言内容不得大于" & CSTR(AnnounceMaxBytes) & "bytes"
   		foundError=true
	end if
	    if body="" then
	ErrMsg=ErrMsg+"<Br>"+"<li>没有填写内容或重复提交"
   		foundError=true
      	end if
	session("antry")=""
	end function 
	
	sub haveRe()
		dim username1,rs1,sql
		sql="select username from bbs1 where AnnounceID="&rootID
		rs1=conn.execute (sql)
		username1=rs1(0)
		set rs1=nothing
		
		if username<>username1 then
			sql="select count(*) from bbs1 where rootID="&rootID&" and username<>'"&username1&"'"
			rs1=conn.execute (sql)
			if rs1(0)=1 then
				sql="update [user] set reAnn='"&boardID&"|"& rootID &"' where username='"& username1 &"'"
				conn.execute sql
			end if
			set rs1=nothing
		end if
	end sub
	sub success(somerr)
	response.write "<br><table cellpadding=0 cellspacing=0 border=0 width=95% bgcolor="&atablebackcolor&" align=center>"&_
		"<tr><td><table cellpadding=3 cellspacing=1 border=0 width=""100%"">"&_
		"<tr align=center><td width=""100%"" bgcolor="&atabletitlecolor&">操作成功</td>"&_
		"</tr><tr><td width=""100%"" bgcolor="&tablebodycolor&">"&_
		"<FONT COLOR="&TableFontcolor&">本页面将在3秒后自动返回您所发表的帖子页面,<b>您可以选择以下操作:</b><br><br>"&_
		"<li><a href=index.asp>返回论坛首页</a>"&_
		"<li><a href=list.asp?boardid="&boardid&">"&boardtype&"</a>"&_
		"<li><a href=dispbbs.asp?boardid="&request("boardid")&"&rootid="&request("rootid")&"&id="&request("rootid")&"&star="&request("star")&">发表的帖子</a>"&somerr&""&_
		"</td></tr></table></td></tr></table>"
	end sub
	Function Checkstr(str)
	str=replace(str,"'","''")
	Checkstr=str
	End Function
%>
<!--#include file="footer.asp"-->

⌨️ 快捷键说明

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