%
Dim Action,ID,Page,Temp
Dim Caption,SubmitUrl
Dim Title,Content
If Not BBS.Founduser Then BBS.GoToerr(31)
BBS.CheckBoard()
ID=BBS.CheckNum(request.querystring("ID"))
Page=BBS.CheckNum(request.querystring("page"))
Action=lcase(request.querystring("action"))
If Len(Action)>10 Then BBS.GoToerr(1)
If Session(CacheName & "MyGradeInfo")(10)="1" Then
Temp=" "
End If
Title=BBS.Row("帖子主题:",""&Temp,"75%","")
Select Case Action
Case"vote"
Vote()
Case"reply"
Reply()
Case"edit"
Edit()
Case Else
BBS.Stats="发表新帖"
Submiturl="postsave.asp?boardid="&BBS.boardid
End Select
BBS.Head "post.asp?boardid="&BBS.boardid,BBS.BoardName,BBS.Stats
ShowMain()
BBS.Footer()
Set BBS =Nothing
Sub Vote()
Dim i
If Session(CacheName & "MyGradeInfo")(12)="0" Then
Temp="
对不起,您目前的论坛等级没有发表投票主题的权限。
"
Else
Temp="请选择投票项目数:"
For i = 2 to int(BBS.Info(63))
Temp=Temp&""
Next
Temp=Temp&"允许多选 过期时间:
选项1:
选项2:
"
End If
Title=Title&BBS.Row("投票选项:",Temp,"75%","")
BBS.Stats="发表新投票"
SubmitUrl="postsave.asp?boardid="&BBS.boardid
End Sub
Sub Reply()
Dim Rs,BbsID
if ID=0 Then BBS.GoToErr(1)
BBS.Stats="回复帖子"
Set Rs=BBS.Execute("Select Caption,SqlTableID,IsLock,IsDel From [Topic] where TopicID="&ID&" And IsDel=0")
If Rs.Eof Then
BBS.GoToErr(21)
ElseIf Rs(2)=1 Then
BBS.GoToErr(22)
Else
Title=BBS.Row("回复主题:",Rs(0),"75%","22px")
BBS.TB=Rs(1)
End If
Rs.close
Set Rs=Nothing
Submiturl="postsave.asp?Action=Reply&boardid="&BBS.boardid&"&TB="&BBS.TB&"&ID="&ID&"&page="&page
BbsID=BBS.CheckNum(Request.querystring("BbsID"))
If BbsID>0 Then
Set Rs=BBS.Execute("select top 1 B.ReplyTopicID,B.TopicID,B.Name,B.AddTime,B.Content,B.boardid,U.IsShow from [Bbs"&BBS.TB&"] As B inner join [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 BBS.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=BBS.CheckNum(request.querystring("BbsID"))
IF BbsID=0 Or ID=0 Then BBS.GoToErr(1)
Set Rs=BBS.Execute("Select boardid,TopType,SqlTableID,IsLock From [Topic] where IsDel<>1 And TopicID="&ID)
If Rs.Eof Then
BBS.GoToErr(58)
Else
TopicRs=Rs.GetRows(-1)
End If
Rs.Close
Set Rs=BBS.Execute("select boardid,Name,AddTime,TopicID,Caption,Content,IsDel From [Bbs"&TopicRs(2,0)&"] where IsDel<>1 And BbsID="&BbsID&"")
If Rs.eof Then
BBS.GoToErr(58)
Else
If lcase(BBS.MyName)=lcase(rs("name")) Then
If TopicRs(3,0)=1 And BBS.MyAdmin<>9 Then BBS.GoToErr(22)
If Session(CacheName & "MyGradeInfo")(22)="0" Then
If BBS.Info(12)<>"0" And DateDiff("s",Rs("AddTime")+BBS.Info(12)/1440,BBS.NowBbsTime)>0 Then BBS.GoToErr(34)
End If
Else
If Session(CacheName & "MyGradeInfo")(24)="0" Then BBS.GoToErr(33)
If TopicRs(1,0)=5 or TopicRs(1,0)=4 Then'如果是总顶或区顶
If TopicRs(0,0)<>BBS.boardid Then'如果不是本版,版主无权
If BBS.MyAdmin=7 Then BBS.GoToErr(51)
End If
Else
If BBS.MyAdmin=7 And Not BBS.IsBoardAdmin Then BBS.GoToErr(71)
End If
End If
If TopicRs(1,0)=5 or TopicRs(1,0)=4 Then
If lcase(BBS.MyName)<>lcase(rs("name")) Then
End If
Else
If TopicRs(0,0)<>BBS.boardid Then BBS.GotoErr(1)
End If
IF Rs("TopicID")=0 Then
Title=BBS.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
BBS.Stats="编辑帖子"
Submiturl="postsave.asp?Action=Edit&ID="&ID&"&BbsID="&BbsID&"&boardid="&BBS.boardid&"&TB="&TopicRs(2,0)&"&page="&page&""
End Sub
Function ShowMain()
With BBS
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
%>