<% 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="请选择投票项目数:允许多选 过期时间:
选项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="
引用 "&RS(2)&" 的发言内容:
屏蔽内容不能引用

" Else If BBS.Info(60)="0" Then Content="
以下是引用 "&RS(2)&" 在("&Rs(3)&")的发言
"&QuoteCode(Rs(4))&"


" 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&"
" Temp=Temp&title If .Info(15)="1" Then Temp=Temp&.Row("发帖验证码:",.GetiCode,"75%","") Else Temp=Temp&"" End If Face="  " For i=2 to 18 Face=Face&" " if i=9 then Face=Face&"
 " Next Temp=Temp&.Row("你的表情:
在帖子前面",Face,"75%","") If .Info(30)="0" Then Temp1="本论坛暂时关闭上传功能。
" ElseIf Session(CacheName & "MyGradeInfo")(14)="0" then Temp1="您目前的论坛等级组没有上传的权限!" ElseIf .BoardString(14)="0" then Temp1="本版面暂时关闭上传功能。" ElseIf .BoardString(14)="2" And Session(CacheName & "MyInfo")(17)="0" then Temp1="本版面只允许VIP会员有上传权限!" Else Temp1=" 可上传文件类型:"&Replace(.Info(34)&"|"&.Info(35),"|","、") Temp1=Temp1&"" End if Temp=Temp&.Row("附件上传:
每日您可以上传"&Session(CacheName & "MyGradeInfo")(15)&"个(最大"&Session(CacheName & "MyGradeInfo")(16)&"KB)",Temp1,"75%","42px") Temp1="
内容限制:"&Session(CacheName & "MyGradeInfo")(9)&"字节
HTML标签:" If .Info(60)="1" Then Temp1=Temp1&"×" Else Temp1=Temp1&"√" Temp1=Temp1&"
UBB标签:
上传文件:" If .Info(30)="0" Then Temp1=Temp1&"×" Else Temp1=Temp1&"√" Temp1=Temp1&"
发特殊帖:
"&_ Especial("回复可见","Especial('[REPLY]','[\/REPLY]')",.Info(70))&_ Especial("金钱可见","Coin()",.Info(71))&"
"&_ Especial("积分可见","Mark()",.Info(72))&_ Especial("日期可见","Showdate()",.Info(73))&"
"&_ Especial("性别可见","Sex()",.Info(74))&_ Especial("登陆可见","Especial('[LOGIN]','[\/LOGIN]')",.Info(75))&"
"&_ Especial("指定读者","Name()",.Info(76))&_ Especial("付费观看","Buypost()",.Info(77))&"
"&_ Especial("插入代码识别转换","Code()",.Info(68)) Temp1=Temp1&"
  • 发帖请遵守国家法律
  • 禁止发表政治及色情内容
" If .Info(60)="1" Then S1="UbbEdit()" Else S1="HtmlEdit()" S1="" If BBS.CC(0)="1" Then S1=S1&"  " End IF If Action="edit" And Session(CacheName & "MyGradeInfo")(25)="1" Then S1= S1 & "不留下编辑标记" If Action="" then If (BBS.MyAdmin=7 And Not BBS.IsBoardAdmin) Then Else S1=S1&"主题设置:" If Session(CacheName&"MyGradeInfo")(31)="1" Then S1= S1 & "置顶 " If Session(CacheName&"MyGradeInfo")(32)="1" Then S1= S1 & "区置顶 " If Session(CacheName&"MyGradeInfo")(33)="1" Then S1= S1 & "总置顶 " If Session(CacheName&"MyGradeInfo")(34)="1" Then S1= S1 & "精华 " If Session(CacheName&"MyGradeInfo")(35)="1" Then S1= S1 & "锁定" End If End If Temp=Temp&.Row("帖子内容:"&Temp1,S1,"75%","") Temp=Temp&"
" Temp=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 %>