<%@ LANGUAGE="VBSCRIPT" %>
<%
rem ----------------------
rem ------主程序开始------
rem ----------------------
dim UserName
dim userPassword
dim useremail
dim article
dim Topic
dim body
dim somerr
dim dateTimeStr
dim ParentID
dim UserID
dim newUser
dim RootID
dim iLayer
dim iOrders
dim ip
dim announceid
dim Expression
dim FoundUser
dim boardID,top
dim boardtype
dim signflag
dim mailflag
dim TIME_ADJUST
dim rs
dim sql
dim lockboard
dim boardskin
dim Email,mailbody
dim boardstat
boardskin=1
rem ------获取参数------
call getInput()
rem -----检查user输入数据的合法性------
call chkData()
if foundErr=true then
call nav()
call headline(2)
call Error()
else
call checkUser()
call nav()
call headline(2)
if foundErr then
call Error()
else
call saveReAnnounce()
end if
end if
call endline()
rem ----------------------
rem ------主程序结束------
rem ----------------------
rem 检测用户输入数据
sub checkUser()
call boardinfo(boardid)
select case boardskin
case 1
case 2
exit sub
case 3
case 4
if not(boardmaster or master) then
Founderr=true
Errmsg=Errmsg+" "+"
精华区，只允许版主和坛主发言和操作"
exit sub
end if
case 5
if username="" then
founderr=true
Errmsg=Errmsg+" "+"
本论坛为认证论坛，请登陆并确认您的用户名已经得到管理员的认证后进入。"
exit sub
else
if chkboardlogin(boardid,username)=false then
founderr=true
Errmsg=Errmsg+" "+"
本论坛为认证论坛，请确认您的用户名已经得到管理员的认证后进入。"
exit sub
end if
end if
case 6
if username="" then
Founderr=true
Errmsg=Errmsg+" "+"
正规论坛，只有登陆用户才能浏览论坛并发言"
exit sub
end if
end select
set rs=server.createobject("adodb.recordset")
sql="select locktopic from bbs1 where announceid="&cstr(rootid)
rs.open sql,conn,1,1
if not rs.eof and not rs.bof then
if rs("locktopic")=1 then
Errmsg=ErrMsg+" "+"
本主题已经锁定，不能发表回复。"
foundErr=true
exit sub
end if
end if
rs.close
set rs=nothing
usercookies=request.Cookies("aspsky")("usercookies")
if isnull(usercookies) or usercookies="" then usercookies=3
if chkuserlogin(username,userpassword,usercookies,3)=false then
errmsg=errmsg+" "+"
您的用户名并不存在，或者您的密码错误，或者您的帐号已被管理员锁定。"
founderr=true
exit sub
end if
if lockboard=1 then
if not master then
Errmsg=ErrMsg+" "+"
您没有权限在本版面发布贴子！"
FoundErr=true
end if
end if
stats=boardtype & "回复帖子成功"
end sub
rem 保存贴子信息
sub saveReAnnounce()
dim rsLayer
set rsLayer=conn.execute("select layer,orders from bbs1 where announceid="&cstr(parentid))
if not(rsLayer.eof and rsLayer.bof) then
if isnull(rsLayer(0)) then
iLayer=0
else
iLayer=rslayer(0)
end if
if isNUll(rslayer(1)) then
iOrders=0
else
iOrders=rsLayer(1)
end if
else
iLayer=0
iOrders=0
end if
rsLayer.close
if rootid<>0 then
iLayer=ilayer+1
conn.execute "update bbs1 set orders=orders+1 where rootid="&cstr(RootID)&" and orders>"&cstr(iOrders)
iOrders=iOrders+1
end if
DateTimeStr=CSTR(NOW()+TIMEADJUST/24)
Sql="insert into bbs1(Boardid,ParentID,Child,username,topic,body,DateAndTime,hits,length,rootid,layer,orders,ip,Expression,locktopic,signflag,emailflag,istop,isbest,isvote,times) values "&_
"("&_
boardid&","&ParentID&",0,'"&_
username&"','"&_
topic&"','"&_
body&"','"&_
DateTimeStr&"',0,'"&_
strlength(body)&"',"&RootID&","&ilayer&","&iorders&",'"&ip&"','"&_
Expression&"',0,"&signflag&","&mailflag&",0,0,0,0)"
conn.execute(sql)
set rs=conn.execute("select top 1 announceid from bbs1 order by announceid desc")
announceid=rs(0)
if err.number<>0 then
err.clear
ErrMsg=ErrMsg+" "+"
数据库操作失败，请以后再试:"&err.Description
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()
call success(somerr)
end if
set rs=nothing
end sub
'今日帖子
function boardtoday(boardid)
tmprs=conn.execute("Select count(announceid) from bbs1 Where datediff('d',dateandtime,Now())=0 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 datediff('d',dateandtime,Now())=0")
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")&"，您好： "
mailbody=mailbody & "您在"&ForumName&"发表的文章有人回复了 "
mailbody=mailbody & "请到以下地址浏览该贴子内容。 "
mailbody=mailbody & "查看贴子内容"
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+"
"+"贴子已经成功保存。作者Email发送没有成功。"
end if
end if
end if
rs.close
end if
end sub
'更新用户在线资料
sub activeuser()
dim rsactiveusers,activeuser
dim membername
dim memberword
dim memberclass
membername=request.cookies("aspsky")("username")
memberword=request.cookies("aspsky")("password")
memberclass=request.cookies("aspsky")("userclass")
ComeFrom=address(Request.ServerVariables("REMOTE_HOST"))
actCome=address(Request.ServerVariables("HTTP_X_FORWARDED_FOR"))
statuserid=replace(Request.ServerVariables("REMOTE_HOST"),".","")
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,ComeFrom,actCome) values "&_
"("&statuserid&",'"&membername&"','"&memberclass&"','"&_
Request.ServerVariables("REMOTE_HOST")&"',Now(),Now(),'"&DateToStr(now())&"','"&_
Request.ServerVariables("HTTP_USER_AGENT")&"','"&_
boardtype&"','"&ComeFrom&"','"&actCome&"')"
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
foundErr=true
Errmsg=Errmsg+" "+"
请指定论坛版面。"
elseif not isInteger(request("boardid")) then
foundErr=true
Errmsg=Errmsg+" "+"
非法的版面参数。"
else
boardID=request("boardID")
end if
if request("followup")="" then
foundErr=true
Errmsg=Errmsg+" "+"
非法的贴子参数。"
elseif not isInteger(request("followup")) then
foundErr=true
Errmsg=Errmsg+" "+"
非法的贴子参数。"
else
announceid=request("followup")
ParentID=request("followup")
end if
if request("RootID")="" then
foundErr=true
Errmsg=Errmsg+" "+"
非法的贴子参数。"
elseif not isInteger(request("RootID")) then
foundErr=true
Errmsg=Errmsg+" "+"
非法的贴子参数。"
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("Content")))
signflag=Checkstr(trim(request("signflag")))
mailflag=Checkstr(trim(request("emailflag")))
boardtype=Checkstr(trim(request("boardtype")))
if signflag="yes" then
signflag=1
else
signflag=0
end if
if mailflag="yes" then
mailflag=1
else
mailflag=0
end if
end sub
rem -----检查user输入数据的合法性------
function chkData()
if instr(Expression,"face")=0 then
Randomize
Do While Len(rndnum)<1
num1=CStr(Chr((57-48)*rnd+48))
rndnum=rndnum&num1
loop
Expression="face" & rndnum & ".gif"
end if
limitime=10
if not (isnull(session("lastpost")) or boardmaster or master) then
if DateDiff("s",session("lastpost"),Now())"+"
本论坛限制发贴距离时间为10秒，请稍后再发。"
FoundErr=True
end if
end if
if UserName="" or strLength(UserName)>20 then
ErrMsg=ErrMsg+" "+"
请输入姓名(长度不能大于20)"
foundErr=True
end if
if strLength(topic)>100 then
foundErr=True
if strLength(ErrMsg)=0 then
ErrMsg=ErrMsg+" "+"
主题长度不能超过100"
else
ErrMsg=ErrMsg+" "+"
主题长度不能超过100"
end if
end if
if request("method")="Topic" then
if topic="" then
if body="" then
ErrMsg=ErrMsg+" "+"
主题和内容必须填写其一。"
foundErr=True
end if
end if
end if
if request("method")="fastreply" then
if body="" then
ErrMsg=ErrMsg+" "+"
快速回复请填写发言内容。"
foundErr=True
end if
end if
if strLength(body)>AnnounceMaxBytes then
ErrMsg=ErrMsg+" "+"
发言内容不得大于" & CSTR(AnnounceMaxBytes) & "bytes"
foundErr=true
end if
if body="" then
ErrMsg=ErrMsg+" "+"
没有填写内容。"
foundErr=true
end if
session("lastpost")=Now()
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 ""
response.write "