<!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<!--#include file=inc/ubbcode.asp-->
<!--#include file=inc/Email_Cls.asp-->
<%
 '=========================================================
' File: artsavepost.asp
' Version:3.0
' Date: 2005-10-23
' Script Written by xmrxw
'=========================================================
' Copyright (C) 2004,2005 Xmrxw.Com All rights reserved.
' Web: http://www.xmrxw.com,http://www.xmzxw.com
' Email: info@mssky.com,super@mssky.com
' QQ：10689579　Msn：zdlmicr@hotmail.com
'=========================================================
dim action,Title,Topics,Content,Editor,Comefrom
dim signflag,emailflag,istop,IncludePic,Username
dim dateTimeStr,usercookies
BoardID=Checkstr(Request.Form("BoardID"))
action=Checkstr(Request.Form("action"))
id=Checkstr(Request.Form("id"))
Topics=Checkstr(Request.Form("Topics"))
Title=Checkstr(trim(request.Form("Title")))
UserName=Checkstr(trim(request.Form("username")))
Editor=Checkstr(trim(request.Form("Editor")))
Comefrom=Checkstr(trim(request.Form("Comefrom")))
Content=Checkstr(request.form("Content"))
istop=Checkstr(trim(request.Form("istop")))
signflag=Checkstr(trim(request.Form("signflag")))
emailflag=Checkstr(trim(request.Form("emailflag")))
IncludePic=Checkstr(trim(request.Form("IncludePic")))
if BoardID="" or not isInteger(BoardID) then
founderr=true
Errmsg=Errmsg+"<br>"+"<li>非法版块参数。"
else
BoardID=clng(BoardID)
end if
if signflag=1 then
signflag=1
else
signflag=0
end if
if emailflag="" then
emailflag=0
else
emailflag=emailflag
end if
if istop="" then
istop=0
end if
if IncludePic="" then
IncludePic=0
end if

if Not ChkPost then'查检提交数据
	ErrMsg=ErrMsg+"<Br>"+"<li>您提交的数据不合法，请不要从外部提交发言。"
   	FoundErr=True
end if

if Cint(Codeshow(6))=1 then
	if Not CodeIsTrue() then
		errmsg=errmsg+"<br>"+"<li>验证码校验失败，请返回刷新页面后再输入验证码。"
		founderr=true
	end if
end if

if Title="" then
	FoundErr=True
	ErrMsg=ErrMsg+"<Br>"+"<li>文章的主题不应为空。"
elseif strLength(Title)>100 then
	FoundErr=True
	ErrMsg=ErrMsg+"<Br>"+"<li>文章主题长度不能超过100"
end if
if action<>"re" then''判断是否回复
	if Editor<>"" and strLength(Editor)>20 then
		FoundErr=True
		ErrMsg=ErrMsg+"<Br>"+"<li>文章作者长度不大于20"
	end if
	if Comefrom<>"" and strLength(Comefrom)>100 then
		FoundErr=True
		ErrMsg=ErrMsg+"<Br>"+"<li>文章来源长度不大于100"
	end if
	if Clng(GroupSetting(17))<>0 and strLength(Content)>Clng(GroupSetting(17)) then
		ErrMsg=ErrMsg+"<Br>"+"<li>发言内容不得大于" & CSTR(GroupSetting(17)) & "字符"
		FoundErr=true
	end if
else
	if id="" or not isnumeric(id) then
	FoundErr=True
		ErrMsg=ErrMsg+"<Br>"+"<li>参数错误"
	end if
	if Clng(GroupSetting(27))<>0 and strLength(Content)>Clng(GroupSetting(27)) then
		ErrMsg=ErrMsg+"<Br>"+"<li>评论内容不得大于" & CSTR(GroupSetting(27)) & "字符"
		FoundErr=true
	end if
end if
if Content="" then
	ErrMsg=ErrMsg+"<Br>"+"<li>没有填写内容。"
	FoundErr=true
end if
session("lastpost")=Now()

if not founduser then
	Errmsg=Errmsg+"<br>"+"<li>您还没有登陆，请登陆后进行修改。"
	founderr=true
end if
if founderr then
	call nav()
	call head_var("","")
	call Mslove_error()
else
	call nav()
	stats="保存成功"
	call head_var("玫瑰美文","artindex.asp")
dim locktopic,Istoptrue,id,Checked
if master or Supermaster or Standmaster then''管理员、管家
	locktopic=0
	if istop<>"" then
	Istoptrue=istop
	else
	Istoptrue=0
	end if
	Checked=1
elseif not (master or Supermaster or Standmaster) then
	locktopic=3
	Istoptrue=0
	Checked=0
else
	locktopic=0
	Istoptrue=0
	Checked=0
end if
DateTimeStr=replace(replace(CSTR(NOW()+Servertime/24),"上午",""),"下午","")

Select Case action
	Case "new"
		Stats="新添加文章"
		Call add()
	Case "edit"
		Stats="修改文章"
		Call edit()
	Case "re"''评论
		Stats="评论文章"
		Call rebbs()
	case else
		call main()
End Select
if founderr then call Mslove_error()
end if
call activeonline()
call footer()

sub add()
dim Dcount
sql="select count(id) from [Ms_Article] where Username='"&trim(membername)&"' and datediff('d',Addtime,now())=0"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
Dcount=rs(0)
else
Dcount=0
end if
rs.close

if Cint(GroupSetting(16))<>0 and dateadd("n",Cint(GroupSetting(16)),myjoinDate)>=Now() then
  	errmsg=errmsg+"<br>"+"<li>新注册用户"&Cint(GroupSetting(16))&"分钟后才能发布文章，请等待升级。"
	founderr=true
end if
if Cint(GroupSetting(13))=0 then
	ErrMsg=ErrMsg+"<Br>"+"<li>您没有发布文章的权限，请与管理员联系。"
   	FoundErr=True
end if
if Cint(GroupSetting(15))<>0 and Dcount>=Cint(GroupSetting(15)) then
  	errmsg=errmsg+"<br>"+"<li>您的文章已经达到限额，请升级再撰写。"
	founderr=true
end if
if Chkvalue(1,GroupSetting(18),Cint(GroupSetting(19)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的金币不够请确认。"
	founderr=true
end if
if Chkvalue(2,GroupSetting(20),Cint(GroupSetting(21)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的魅力值不够请确认。"
	founderr=true
end if
if Chkvalue(3,GroupSetting(22),Cint(GroupSetting(23)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的经验值不够请确认。"
	founderr=true
end if
if founderr=true then exit sub
''插入主题表
sql="insert into Ms_Article (Title,Content,length,BoardID,Username,Editor,Comefrom,Addtime,Topic,locktopic,signflag,emailflag,Istop,IncludePic,Checked) values ('"&Title&"','"&Content&"','"&strlength(Content)&"',"&BoardID&",'"&username&"','"&Editor&"','"&Comefrom&"','"&DateTimeStr&"','"&Topics&"',"&locktopic&","&signflag&","&emailflag&","&Istoptrue&","&IncludePic&","&Checked&")"
conn.execute(sql)

set rs=conn.execute("select top 1 id from Ms_Article order by id desc")
id=rs(0)

conn.execute("update Ms_setup set UserArt=UserArt+1 where Cid=1")
conn.execute("update Ms_user set UserArt=UserArt+1,UserWealth=UserWealth "&GroupSetting(18)&Cint(GroupSetting(19))&",UserEP=UserEP "&GroupSetting(20)&Cint(GroupSetting(21))&",UserCP=UserCP "&GroupSetting(22)&Cint(GroupSetting(23))&" where Username='"&trim(membername)&"'")''发布文
dim PostRetrunName
select case Artsentset
case 1
	response.write "<meta http-equiv=refresh content=""3;URL=index.asp"">"
	PostRetrunName="首页"
case 2
	response.write "<meta http-equiv=refresh content=""3;URL=artlist.asp?boardid="&BoardID&""">"
	PostRetrunName="您所发布的文章列表"
case 3
	if Checked=1 then
	response.write "<meta http-equiv=refresh content=""3;URL=artlist.asp?boardid="&BoardID&""">"
	PostRetrunName="您发布的文章必须经管理员审核后方可见"
	else
	response.write "<meta http-equiv=refresh content=""3;URL=showart.asp?ID="&ID&">"
	PostRetrunName="您所发表的文章"
	end if
end select
set rs=nothing
call showsendinfo(PostRetrunName)
end sub


sub edit()''修改文章
dim addbody,char_changed
addbody=Content

if membername<>request("username") then 
	if Cint(split(edituserset,"|")(0))=1 then
	char_changed = "<br><DIV align=right><FONT color=#000066>[此文章已经被"&membername&"于"&Now()&"编辑过]</FONT></DIV>"
	end if
else
	if Cint(split(edituserset,"|")(1))=1 then
	char_changed = "<br><DIV align=right><FONT color=#000066>[此文章已经被作者于"&Now()&"编辑过]</FONT></DIV>"
	end if
end if
if id="" or not isInteger(id) then
founderr=true
Errmsg=Errmsg+"<br>"+"<li>请指定相关文章。"
else
id=clng(id)
end if

dim LastTopic
dim LastPost
dim caneditpost,body,LastBoard
caneditpost=false
sql="select b.username,b.addtime,u.usergroupID from Ms_Article b,[Ms_user] u where b.username=u.username and b.ID="&ID
set rs=conn.execute(sql)
if rs.eof and rs.bof then
	Errmsg=Errmsg+"<br>"+"<li>没有找到相应的文章。"
	Founderr=true
	exit sub
else
		Body=addbody+chr(13)+chr(10)+char_changed+chr(13)
	if rs("username")=membername then
		if Cint(GroupSetting(25))=0 then
			Errmsg=Errmsg+"<br>"+"<li>您没有编辑自己文章的权限，请<a href=login.asp>登陆</a>或者同管理员联系。"
			founderr=true
			CanEditPost=False
		else
			CanEditPost=True
		end if
	else
		if (master or supermaster or Standmaster or Vipuser) and Cint(GroupSetting(25))=1 then
			CanEditPost=True
		else
			CanEditPost=False
		end if
		if UserGroupID>3 and Cint(GroupSetting(25))=1 then
			CanEditPost=true
		end if
		if Cint(GroupSetting(25))=1  then
			CanEditPost=True
		elseif Cint(GroupSetting(25))=0 then
			CanEditPost=False
		end if
		if UserGroupID<4 and UserGroupID=rs("UserGroupID") then
			Errmsg=Errmsg+"<br>"+"<li>同等级用户不能修改。"
			Founderr=true
			exit sub
		elseif UserGroupID<4 and UserGroupID>rs("UserGroupID") then
			Errmsg=Errmsg+"<br>"+"<li>不能修改等级比您高的用户的文章。"
			Founderr=true
			exit sub
		end if
		if not CanEditPost then
			Errmsg=Errmsg+"<br>"+"<li>您没有足够的权限编辑本文章，请和管理员联系。"
			Founderr=true
			exit sub
		end if
	end if
end if

Set rs = Server.CreateObject("ADODB.Recordset")
sql="SELECT * FROM Ms_Article where username='"&trim(username)&"' and ID="&id
rs.Open sql,conn,1,3
if rs.eof and rs.bof then
	foundErr=True
	ErrMsg=ErrMsg+"<Br>"+"<li>您不是本文章的作者，无权修改！"
	rs.close:set rs=nothing
	exit sub
elseif not master and rs("locktopic")=1 then
	Errmsg=ErrMsg+"<Br>"+"<li>本主题已经锁定，不能编辑。"
	foundErr=true
	rs.close:set rs=nothing
	exit sub
else
	rs("Title") =replace(Title,"''","'")
	rs("Content") =replace(Body,"''","'")
	rs("Editor")=Editor
	rs("Comefrom")=Comefrom
	rs("length")=strlength(body)
	rs("Topic")=Topics
	rs("signflag")=signflag
	rs("emailflag")=emailflag
	rs.Update
	rs.close:set rs=nothing
	end if
	dim PostRetrunName
select case Artsentset
case 1
	response.write "<meta http-equiv=refresh content=""3;URL=index.asp"">"
	PostRetrunName="首页"
case 2
	response.write "<meta http-equiv=refresh content=""3;URL=artlist.asp?Boardid="&Boardid&""">"
	PostRetrunName="您所发布的文章列表"
case 3
	response.write "<meta http-equiv=refresh content=""3;URL=showart.asp?Boardid="&Boardid&"&id="&id&""">"
	PostRetrunName="您所修改的文章"
end select
	call showsendinfo(PostRetrunName)
end sub

sub rebbs()''评论
if Cint(GroupSetting(26))=0 then
	Errmsg=Errmsg+"<br>"+"<li>您没有回复其他人文章的权限，请<a href=login.asp>登陆</a>或者同管理员联系。"
	founderr=true
end if
if Cint(GroupSetting(29))<>0 and dateadd("n",Cint(GroupSetting(29)),myjoinDate)>=Now() then
  	errmsg=errmsg+"<br>"+"<li>新注册用户"&Cint(GroupSetting(29))&"分钟后才能评论文章，请等待升级。"
	founderr=true
end if
''锁定检验
sql="select locktopic from Ms_Article where id="&id
set rs=conn.execute(sql)
if not rs.eof and not rs.bof then
	if not master and rs("locktopic")=1 then
		Errmsg=ErrMsg+"<Br>"+"<li>本主题已经锁定，不能发表回复。"
		founderr=true
	elseif rs("locktopic")=2 then
		Errmsg=ErrMsg+"<Br>"+"<li>本主题已经删除，不能发表回复。"
		founderr=true
	end if
end if
set rs=nothing
if Chkvalue(1,GroupSetting(30),Cint(GroupSetting(31)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的金币不够请确认。"
	founderr=true
end if
if Chkvalue(2,GroupSetting(32),Cint(GroupSetting(33)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的魅力值不够请确认。"
	founderr=true
end if
if Chkvalue(3,GroupSetting(34),Cint(GroupSetting(35)))=false then
	errmsg=errmsg+"<br>"+"<li>对不起，您的经验值不够请确认。"
	founderr=true
end if
if founderr=true then exit sub
''插入回复表
dim rslayer,topic,email,mailbody,sendmsg
''邮件发送
set rsLayer=conn.execute("select b.EmailFlag,b.username,u.userEmail from Ms_Article b inner join [Ms_user] u on b.username=u.username where b.id="&ID)
if not(rsLayer.eof and rsLayer.bof) then
	if rsLayer(1)=membername then
		if Cint(GroupSetting(28))=0 then
		Errmsg=Errmsg+"<br>"+"<li>您没有回复自己主题的权限。"
		founderr=true
		exit sub
		end if
	end if
	if rsLayer(0)=1 or rsLayer(0)=3 then
		topic="您在"&webname&"发表的文章有人回复了"
		email=rsLayer(2)
		mailbody=mailbody & ""&rsLayer(1)&"，您好：<br>"
		mailbody=mailbody & "您在"&webname&"发表的文章有人回复了<br>"
		mailbody=mailbody & "请到以下地址浏览该回复内容。<br>"
		mailbody=mailbody & "<a href=http://"&request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),"artsavepost.asp","")&"showart.asp?boardid="&boardid&"&id="&id&" target=_blank>查看回复内容</a>"
		Dim DvEmail
	Set DvEmail = New Dv_SendMail
		DvEmail.SendObject = Cint(Mailtype)	'设置选取组件 1=Jmail,2=Cdonts,3=Aspemail,0不支持
		DvEmail.ServerLoginName = Mailuser	'您的邮件服务器登录名
	    DvEmail.ServerLoginPass = Mailpass	'登录密码
		DvEmail.SendSMTP = Mailsmtp			'SMTP地址
		DvEmail.SendFromEmail = Mailsend		'发送来源地址
		DvEmail.SendFromName = Webname		'发送人信息
		If DvEmail.ErrCode = 0 Then
			DvEmail.SendMail useremail,topic,mailbody	'执行发送邮件
			If MsEmail.Count>0 Then
			sendmsg="<li>邮件已经发送成功</li>"
			Else
				sendmsg="<li>由于系统错误，邮件发送不成功</li>"
			End If
		Else
			sendmsg="<li>由于系统错误，邮件不能发送！</li>"
		End If
		Set DvEmail = Nothing
	end if
	if rsLayer(0)=2 or rsLayer(0)=3 then
	dim mtitle,messages
		mtitle="您在"&webname&"发表的文章有人回复了"
		messages="<a href=http://"&request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),"artsavepost.asp","")&"showart.asp?boardid="&boardid&"&id="&id&" target=_blank>查看回复内容</a>"
		sql="insert into Ms_message (incept,sender,title,content,sendtime,flag,issend) values ('"&rsLayer(1)&"','"&trim(membername)&"','"&mtitle&"','"&messages&"',Now(),0,1)"
		conn.execute(sql)
	end if
	rsLayer.close
end if
Sql="insert into Ms_Artbbs (ArtID,Username,Title,Content,Addtime,Topic,Boardid) values ("&id&",'"&trim(membername)&"','"&Title&"','"&Content&"','"&DateTimeStr&"','"&Topics&"',"&boardid&")"
conn.execute(sql)
conn.execute("update Ms_Article set Ubbs=Ubbs+1 where id="&id)
conn.execute("update Ms_user set UserWealth=UserWealth "&GroupSetting(30)&Cint(GroupSetting(31))&",UserEP=UserEP "&GroupSetting(32)&Cint(GroupSetting(33))&",UserCP=UserCP "&GroupSetting(34)&Cint(GroupSetting(35))&" where Username='"&trim(membername)&"'")

dim PostRetrunName
select case Artsentset
case 1
	response.write "<meta http-equiv=refresh content=""3;URL=index.asp"">"
	PostRetrunName="首页"
case 2
	response.write "<meta http-equiv=refresh content=""3;URL=artlist.asp?boardid="&boardid&""">"
	PostRetrunName="您所发布的文章列表"
case 3
	if Checked=1 then
	response.write "<meta http-equiv=refresh content=""3;URL=artlist.asp?boardid="&boardid&""">"
	PostRetrunName="您发布的回复必须经管理员审核后方可见"
	else
	response.write "<meta http-equiv=refresh content=""3;URL=showart.asp?boardid="&boardid&"&id="&id&""">"
	PostRetrunName="您所发表的回复"
	end if
end select
set rs=nothing
call showsendinfo(PostRetrunName)
end sub


sub showsendinfo(PostRetrunName)
%>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<tr align=center><th width="100%">状态：<%=stats%></td>
</tr><tr><td width="100%" class=tablebody1>
本页面将在3秒后自动返回<%=PostRetrunName%>，<b>您可以选择以下操作：</b><br><ul>
<li><a href="index.asp">返回首页</a></li>
<li><a href="artlist.asp?BoardID=<%=BoardID%>">文章列表</a></li>
<li><%if Checked=1 then%><%=PostRetrunName%><%else%><a href="showart.asp?boardid=<%=boardid%>&id=<%=id%>"><%=PostRetrunName%></a><%end if%></li>
</ul></td></tr></table>
</body>
</html>
<%end sub%>