<%
Dim Action,ID,Page,Temp
Dim Caption,SubmitUrl
Dim Title,Content
If Not MNBoard.Founduser Then MNBoard.GoToerr(31)
MNBoard.CheckBoard()
ID=MNBoard.CheckNum(request.querystring("ID"))
Page=MNBoard.CheckNum(request.querystring("page"))
Action=lcase(request.querystring("action"))
If Len(Action)>10 Then MNBoard.GoToerr(1)
If Session(CacheName & "MyGradeInfo")(10)="1" Then
Temp=" "
End If
Title=MNBoard.Row("帖子主题：",""&Temp,"75%","")
Select Case Action
Case"vote"
Vote()
Case"reply"
Reply()
Case"edit"
Edit()
Case Else
MNBoard.Stats="发表新帖"
Submiturl="postsave.asp?BoardID="&MNBoard.BoardID
End Select
MNBoard.Head "Post.asp?BoardID="&MNBoard.BoardID,MNBoard.BoardName,MNBoard.Stats
ShowMain()
MNBoard.Footer()
Set MNBoard =Nothing
Sub Vote()
Dim i
If Session(CacheName & "MyGradeInfo")(12)="0" Then
Temp="
对不起，您目前的论坛等级没有发表投票主题的权限。
"
Else
Temp="请选择投票项目数："
For i = 2 to int(MNBoard.Info(63))
Temp=Temp&""
Next
Temp=Temp&"允许多选 过期时间：
选项1：
选项2：
"
End If
Title=Title&MNBoard.Row("投票选项：",Temp,"75%","")
MNBoard.Stats="发表新投票"
SubmitUrl="postsave.asp?BoardID="&MNBoard.BoardID
End Sub
Sub Reply()
Dim Rs,BbsID
if ID=0 Then MNBoard.GoToErr(1)
MNBoard.Stats="回复帖子"
Set Rs=MNBoard.Execute("Select Caption,SqlTableID,IsLock,IsDel From [i_Topic] where TopicID="&ID&" And IsDel=0")
If Rs.Eof Then
MNBoard.GoToErr(21)
ElseIf Rs(2)=1 Then
MNBoard.GoToErr(22)
Else
Title=MNBoard.Row("回复主题：",Rs(0),"75%","22px")
MNBoard.TB=Rs(1)
End If
Rs.close
Set Rs=Nothing
Submiturl="postsave.asp?Action=Reply&BoardID="&MNBoard.BoardID&"&TB="&MNBoard.TB&"&ID="&ID&"&page="&page
BbsID=MNBoard.CheckNum(Request.querystring("BbsID"))
If BbsID>0 Then
Set Rs=MNBoard.Execute("select top 1 B.ReplyTopicID,B.TopicID,B.Name,B.AddTime,B.Content,B.BoardID,U.IsShow from [i_Bbs"&MNBoard.TB&"] As B inner join [i_User] As U on B.Name=U.Name where B.BbsID="&BbsID&" And B.IsDel=0")
If Not Rs.Eof Then
If Rs(1)<>ID And Rs(0)<> ID Then MNBoard.GoToErr(1)
If Rs(6)=1 Then
Content="
"
Else
Content="[quote]以下是引用 [B]"&RS(2)&"[/B] ： "&QuoteCode(Rs(4))&" [/quote] "
End If
End If
End if
Rs.close
Set Rs=Nothing
End If
End Sub
Sub Edit()
Dim Rs,BbsID,TopicIsLock,TopicRs,IsTop
BbsID=MNBoard.CheckNum(request.querystring("BbsID"))
IF BbsID=0 Or ID=0 Then MNBoard.GoToErr(1)
Set Rs=MNBoard.Execute("Select BoardID,TopType,SqlTableID,IsLock From [i_Topic] where IsDel<>1 And TopicID="&ID)
If Rs.Eof Then
MNBoard.GoToErr(58)
Else
TopicRs=Rs.GetRows(-1)
End If
Rs.Close
Set Rs=MNBoard.Execute("select BoardID,Name,AddTime,TopicID,Caption,Content,IsDel From [i_Bbs"&TopicRs(2,0)&"] where IsDel<>1 And BbsID="&BbsID&"")
If Rs.eof Then
MNBoard.GoToErr(58)
Else
If lcase(MNBoard.MyName)=lcase(rs("name")) Then
If TopicRs(3,0)=1 And MNBoard.MyAdmin<>9 Then MNBoard.GoToErr(22)
If Session(CacheName & "MyGradeInfo")(22)="0" Then
If MNBoard.Info(12)<>"0" And DateDiff("s",Rs("AddTime")+MNBoard.Info(12)/1440,MNBoard.NowBbsTime)>0 Then MNBoard.GoToErr(34)
End If
Else
If Session(CacheName & "MyGradeInfo")(24)="0" Then MNBoard.GoToErr(33)
If TopicRs(1,0)=5 or TopicRs(1,0)=4 Then'如果是总顶或区顶
If TopicRs(0,0)<>MNBoard.BoardID Then'如果不是本版，版主无权
If MNBoard.MyAdmin=7 Then MNBoard.GoToErr(51)
End If
Else
If MNBoard.MyAdmin=7 And Not MNBoard.IsBoardAdmin Then MNBoard.GoToErr(71)
End If
End If
If TopicRs(1,0)=5 or TopicRs(1,0)=4 Then
If lcase(MNBoard.MyName)<>lcase(rs("name")) Then
End If
Else
If TopicRs(0,0)<>MNBoard.BoardID Then MNBoard.GotoErr(1)
End If
IF Rs("TopicID")=0 Then
Title=MNBoard.Row("编辑回复帖：",rs(4),"75%","23px")
Else
Title=replace(Title,"id='caption'","id='caption' value='"&Rs(4)&"'")
End IF
Content=ReplaceUBB(rs(5))
End if
Rs.Close
MNBoard.Stats="编辑帖子"
Submiturl="postsave.asp?Action=Edit&ID="&ID&"&BbsID="&BbsID&"&BoardID="&MNBoard.BoardID&"&TB="&TopicRs(2,0)&"&page="&page&""
End Sub
Function ShowMain()
With MNBoard
Dim Face,I,Temp1,S1
Temp=""
Temp=Temp&""
.ShowTable .Stats,Temp
End With
End Function
'==--->>>编辑帖子兼容老帖
Function replaceUBB(str)
dim re
If Str="" Then Exit Function
Set re=new RegExp
re.IgnoreCase=true
re.Global=True
re.Pattern="(>)("&vbNewLine&")(<)"
Str=re.Replace(Str,"$1$3")
re.Pattern="(>)("&vbNewLine&vbNewLine&")(<)"
Str=re.Replace(Str,"$1$3")
re.Pattern=vbNewLine
Str=re.Replace(Str," ")
re.Pattern="(\[right\])(\[color=(.[^\[]*)\])(.[^\[]*)(\[\/color\])(\[\/right\])"
str=re.Replace(str," ")
re.Pattern="(
「该帖子被(.*)编辑过」<\/div>)"
str=re.Replace(str," ")
str=Replace(Str," "," ")
Set re=Nothing
replaceUBB=str
End function
Function Especial(eName,gourl,Flag)
If flag="1" Then
Especial=""&eName&"√ "
Else
Especial=eName&" × "
End If
End Function
Function QuoteCode(str)
Dim re,restr
Set re=new RegExp
re.IgnoreCase=true
re.Global=True
restr="加密内容不能引用 "
re.Pattern="(\[DATE=(.[^\[]*)\])(.+?)(\[\/DATE\])"
str=re.Replace(str,restr)
re.Pattern="(\[SEX=*([0-1]*)\])(.+?)(\[\/SEX\])"
str=re.Replace(str,restr)
re.Pattern="(\[COIN=*([0-9]*)\])(.+?)(\[\/COIN\])"
str=re.Replace(str,restr)
re.Pattern="(\[USERNAME=(.[^\[]*)\])(.+?)(\[\/USERNAME\])"
str=re.Replace(str,restr)
re.Pattern="(\[GRADE=*([0-9]*)\])(.+?)(\[\/GRADE\])"
str=re.Replace(str,restr)
re.Pattern="(\[MARK=*([0-9]*)\])(.+?)(\[\/MARK\])"
str=re.Replace(str,restr)
re.Pattern="(\[BUYPOST=*([0-9]*)\])(.+?)(\[\/BUYPOST\])"
str=re.Replace(str,restr)
re.Pattern=vbcrlf&vbcrlf&vbcrlf&"(\[RIGHT\])(\[COLOR=(.[^\[]*)\])(.[^\[]*)(\[\/COLOR\])(\[\/RIGHT\])"
str=re.Replace(str,"")
re.Pattern="(\[reply\])(.+?)(\[\/reply\])"
Str=re.Replace(str,restr)
QuoteCode=replaceUBB(str)
Set re=Nothing
End Function
%>