📄 savereannounce.asp
字号:
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 + -