<!--#INCLUDE FILE="setup.asp" -->
<!--#include file="checkuser.asp" -->
<!--#INCLUDE FILE="theme.asp" -->
<!--#include file="include/char.asp" -->
<%
locat="校友留言"
act="回复主题"
Call top(2,1)

Dim TopicID
Dim ReplyNum

if membername="" Then
  	ErrMsg=ErrMsg+"<br>"+"<li>您还没有<a href=login.asp>登录</a>。"
	Call Error("Information",ErrMsg)
Else
	if chktopic=true then
		if Request("Action")="Reply" Then
			Dim Topic,body
			Call savereply()
		Else
			Call ShowReplyForm()
		End if
	end if
End if

	
Function chktopic()

	dim FoundErr,ErrMsg
	dim rs
	if Request("TopicID")="" Then
		FoundErr=True
		Errmsg=Errmsg+"<br>"+"<li>请指定要回复的贴子。"
	ElseIf not isInteger(Request("TopicID")) Then
		FoundErr=True
		Errmsg=Errmsg+"<br>"+"<li>非法的贴子参数。"
	Else
		TopicID=clng(Request("TopicID"))
	End if

	if FoundErr Then
		Call Error("Exclmation",ErrMsg)
		chktopic=False
		Exit Function
	End if

   	Set rs=conn.execute("Select locked,replys from topic where postid="&TopicID&"")
	if rs.bof and rs.eof Then
		FoundErr = True
		ErrMsg=ErrMsg+"<br>"+"<li>指定的贴子不存在</li>"
	ElseIf rs(0) and not sysadmin Then
		FoundErr=True
		Errmsg=Errmsg+"<br>"+"<li>本主题已被锁定，不能发表回复。"
	else
		ReplyNum=rs(1)
	End if
	Set rs=Nothing

	chktopic=not founderr
	
	if FoundErr Then
		Call Error("Exclamation",ErrMsg)
	End if

End Function



Sub ShowReplyForm()

Dim advmode
Dim isQuotePost
Dim QuotePostNo
dim sql,qrs
dim content,quotecontent

isQuotePost=False

if Request("QuotePost")<>"" Then
	QuotePostNo=Clng(Request("QuotePost"))
	'if topicID=QuotePostNo then
	'	sql="select userid,body,posttime from topic where postid="&topicID
	'else
		sql="Select userid,body,posttime from reply where postid="&QuotePostNo
	'end if
	Set qrs=conn.execute(sql)
	if not (qrs.eof and qrs.bof) Then
		content=reubbcode(qrs(1))
		content = replace(content, "&gt;", ">")
		content = replace(content, "&lt;", "<")
		content = Replace(content, "</P><P>", vbLf&vbLf)
		content = Replace(content, "<BR>", vbLf)
		quotecontent="[quote][b]以下是引用[i]"&qrs(0)&"在"&qrs(2)&"[/i]的发言：[/b]"
		quotecontent=quotecontent+vbCr+content+vbCr+"[/quote]"
		isQuotePost=True
	End if
	Set qrs=nothing
End if


if Request("Mode")="Advanced" Then
	advmode=True
ElseIf Request("Mode")="Typical" Then
	advmode=False
Else
	advmode=BoolVar(3)
End if

%>
<BR><BR>
<form action="NewReply.asp" method="POST" onsubmit="submitonce(this)" name="frmgbk">
<input type=hidden name=Action value="Reply">
<input type=hidden name=TopicID value="<%=TopicID%>">
<div align="center"><center>
<table Class=TableBorder cellpadding=0 cellspacing=0 border=0 width=100% cellspacing="0">
    <tr>
      <td width="100%">
<table cellpadding=5 cellspacing=1 border=0 width=100%>
    <tr>
      <th width="100%" colspan=2>回复主题&nbsp;<%if advmode=False Then%><A HREF="?TopicID=<%=TopicID%>&Mode=Advanced<%if isquotepost Then Response.Write "&QuotePost="&QuotePostNo%>" title="当前为简洁模式，按此切换到高级发贴模式">[高级模式]</A><%Else%><A HREF="?TopicID=<%=TopicID%>&Mode=Typical<%if isquotepost Then Response.Write "&QuotePost="&QuotePostNo%>" title="当前为高级模式，按此切换到简洁发贴模式">[简洁模式]</A><%End if%></font></th>
    </tr>
        <tr Class=LightTableBody>
          <td width="22%">作者：
	  </td>
		            <td width="78%">&nbsp;<%=htmlencode(membername)%>&nbsp;[<A HREF="Login.asp?Action=logout">退出登录</A>]
	 </td>
        </tr>
        <tr Class=LightTableBody>
          <td width="22%">帖子标题：
              	  </td>
		            <td width="78%">&nbsp;<input name="title" size=68 maxlength=80 class=FormClass>&nbsp;&nbsp;可选,不超过50个汉字</font>
	 </td>
        </tr>

        <tr Class=LightTableBody>
          <td width="22%" valign="middle">发贴心情：</font></td>
          <td width="78%">
<table border=0 width=100%><tr><td>
			  <%for i=1 to 18%>
	<input type="radio" value="<%=i%>" name="mood" <%if i=1 Then Response.Write "checked"%>><img src="mood/face<%=i%>.gif" WIDTH="15" HEIGHT="15">
<%if i=9 Then Response.Write "<br>"
next%>
</td></tr></table>
 </td>
        </tr>

            <tr Class=LightTableBody>
              <td>帖子内容&nbsp;[<a href=javascript:checklength()>检测长度</a>]：<BR><BR><br><li>HTML标签：<font color=brown>OFF</font><BR><li>UBB标签：<%if BoolVar(4)=True Then Response.Write "<font color=#003399>ON" Else Response.Write "<font color=brown>OFF"%></font><BR><li>最大长度：<font color=brown><%=IntVar(1)%>KB</font><BR><BR>
			  <a href="javascript:openScript('help.asp?about=ubb',670,500)"  style="cursor:help"><IMG SRC="IMAGES/help.gif" WIDTH="42" HEIGHT="17" BORDER=0 ALT="查看UBB代码使用说明"></a>
              </td>
              <td><table border=0><%if advmode=True Then%><!--#INCLUDE FILE="include/ubbtools.asp" --><%End if%><tr><td>&nbsp;<textarea onkeydown=ctlent() name="content" rows="10" cols="68" title="Ctrl+Enter可以直接提交帖子"  wrap="soft" ><%if isQuotePost Then Response.Write quotecontent%></textarea></td><td>&nbsp;<font color=red>*</font></td></tr></table></td></tr>

<tr Class=DarkTableBody>
                <td valign=middle colspan=2 align=center>
                <input type=Submit value="发 表" name=Sbmt class=button> &nbsp; &nbsp;
<input type="reset" name="reset" value="清 除" class=button>
                </td></tr>
      </table>
      </td>
    </tr>
  </table>
  </center></div>
</form>
<script language="javascript">
function checklength(theform) {
var ly=frmgbk.content.value;
var strlen=strlength(ly);
alert("您的帖子长度为 "+strlen+" 字符.");

}
</script>


<%
End Sub


Sub savereply()

	dim ip,mood
	dim username
	dim sql,rs
	dim LastReply,LastReplyID
	dim pagesize

	if chkdata=false Then
		session("lastpost")=Now()
	else

		IP=Request.ServerVariables("REMOTE_ADDR") 
		mood=cint(Request.Form("mood"))

		UserName=Checkstr(membername)

		Sql="insert into reply (topicid,userid,title,body,ip,mood) values "&_
			"("&TopicID&",'"&UserName&"','"&topic&"','"&body&"','"&ip&"',"&mood&")"
		conn.execute(sql)

		sql="select max(postid) from reply where topicid="&TopicID
		set rs=conn.execute(sql)
		LastReplyID=rs(0)
		Set rs=Nothing

		LastReply=cutstr(body,25)
		LastReply=replace(LastReply,vbcr,"")
		LastReply=replace(LastReply,vblf," ")
		LastReply=UserName&vbCr&LastReply&vbCr&LastReplyID

		conn.execute("update topic set LastReply='"&LastReply&"',replys=replys+1,LastTime=now() where postid="&TopicID)
		conn.execute("update config Set bbsnum=bbsnum+1,todayNum="&alltodays())

		conn.execute("update student Set point=point+"&PointSet(16)&" where userid='"&UserName&"'")

		session("lastpost")=Now()

		pagesize=Cint(IntVar(8))

		ReplyNum=ReplyNum+2

	  	if ReplyNum mod pagesize=0 Then Pnum=ReplyNum\pagesize Else Pnum=ReplyNum\pagesize+1


		rURL="ViewThread.asp?TopicID="&TopicID&"&Page="&Pnum&"#PID"&LastReplyID
		rtitle="发表帖子成功"
		rmsg="本页面将在3秒后自动返回您所发表的帖子页面，<b>您可以选择以下操作：</b><br><ul>"&_
				"<li><a href=ForumDisplay.asp>返回校友论坛</a></li>"&_
				"<li><a href=ViewThread.asp?TopicID="&TopicID&">返回主题帖子</a></li>"&_
				"<li><a href="&rURL&">发表的帖子</a></li>"&_
				"</ul>"
		Redirect 3,rurl,rtitle,rmsg


	end if

End Sub


Function alltodays()
    	tmprs=conn.execute("Select count(postid) from reply Where datediff('d',posttime,date())=0")
    	alltodays=tmprs(0)
	Set tmprs=Nothing
	if isnull(alltodays) Then alltodays=0
End Function


Function chkData()

	if not sysadmin and not isnull(session("lastpost")) Then
		if DateDiff("s",session("lastpost"),Now())<10 Then
			ErrMsg=ErrMsg+"<Br>"+"<li>本论坛限制发贴间隔时间为10秒，请稍后再发。"
			Call Error("Exclamation",ErrMsg)
			chkdata=False
			Exit Function
		End if
	End if

	if chkpost=False Then
		ErrMsg=ErrMsg+"<Br>"+"<li>您提交的数据不合法，请不要从外部提交数据。"
		Call Error("Critical",ErrMsg)
		chkdata=False
		Exit Function
	End if

	Topic=Checkstr(trim(Request("title")))
	if strLength(topic)>100 Then
		FoundErr=True
		ErrMsg=ErrMsg+"<Br>"+"<li>主题长度不能超过100个字符!"
	End if
		
	Body=Checkstr(rtrim(Request.form("content")))

	if body="" Then
		ErrMsg=ErrMsg+"<Br>"+"<li>没有填写帖子内容。"
		FoundErr=True
	ElseIf strLength(body)>(IntVar(1)*1024) Then
		ErrMsg=ErrMsg+"<Br>"+"<li>帖子内容不得大于" & IntVar(1) & "KBytes"
		FoundErr=True
	End if


	if founderr=True Then
		chkdata=False
		Call Error("Information",ErrMsg)
	Else
		chkdata=True
	End if

End Function



function reUBBCode(strContent)
    strContent = htmlencode(strContent)
    dim re
    Set re=new RegExp
    re.IgnoreCase =true
    re.Global=True

    re.Pattern="(\[QUOTE\])(.*)(\[\/QUOTE\])"
    strContent=re.Replace(strContent,"")

    set re=Nothing
    reUBBCode=strContent
end function

%>
<%Call footer()%>
