<% Response.Expires=0 If Dvbbs.BoardID = 0 Then Response.Write "参数错误" Dvbbs.PageEnd() Response.End End If If Dvbbs.GroupSetting(2)="0" Then Response.Write "" Dvbbs.PageEnd() Response.End End If Dvbbs.LoadTemplates("index") Dim outtext,iouttext Dim num Dim allnum Dim RootID Dim rs,SQL,i RootID=request("rootID") If RootID="" Or Not IsNumeric(RootID) Or (Request("action") <> "1" And Request("action")<>"0") Then Response.End Dim TempStr TempStr=Split(template.html(2),"||") Response.Write "" If Request("action")="1" Then showtree() If Request("action")="0" Then closetree() Response.Write "" Dvbbs.PageEnd() Sub closeTree() TempStr(4)=Replace(TempStr(4),"{$rootid}",rootid) TempStr(4)=Replace(TempStr(4),"{$boardid}",Dvbbs.BoardID) Response.Write TempStr(4) End Sub Sub showtree() Dim Star,page Star=Request("Star") If Star="" Or Not IsNumeric(Star) Then Star=1 Star=Clng(Star) page=star Dim MyTempStr,ii num=0 outtext="     " Dim totalusetable Set Rs=Dvbbs.Execute("Select child,PostTable from dv_topic where topicid="&rootid) allnum=rs(0) totalusetable=rs(1) Dim Board_Setting27 TempStr(3)=Replace(TempStr(3),"{$rootid}",rootid) TempStr(3)=Replace(TempStr(3),"{$boardid}",Dvbbs.BoardID) TempStr(3)=Replace(TempStr(3),"{$alertcolor}",Dvbbs.mainsetting(1)) Response.Write TempStr(3) Response.flush Board_Setting27=Dvbbs.Board_Setting(27) SQL="select T.layer,t.rootid,t.announceid,t.body,t.username,t.postuserid,t.topic,t.locktopic,u.LockUser,t.signflag from "&totalusetable&" t left outer Join [dv_user] U On T.postuserid=u.userid where t.boardid="& Dvbbs.boardid &" and t.rootid="& rootid &" and t.parentid>0 order by t.rootid desc,t.orders" If Not IsObject(Conn) Then ConnectionDatabase Set Rs=Dvbbs.iCreateObject("adodb.recordset") rs.open sql,conn,1,1 If Not (Rs.Eof And Rs.Bof) Then If allnum <> Rs.RecordCount Then allnum=Rs.RecordCount Dvbbs.Execute("Update dv_topic Set child="&allnum&" Where topicid="&rootid) End If Rs.PageSize=Cint(Dvbbs.Board_Setting(27)) Rs.AbsolutePage=Star SQL=Rs.GetRows(Rs.PageSize) Response.Write "" TempStr=Null End If Set Rs=Nothing End Sub Function dvHTMLEncode(fString) If Not IsNull(fString) Then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, CHR(32), " ") fString = Replace(fString, CHR(9), " ") fString = Replace(fString, CHR(34), """) fString = Replace(fString, CHR(39), "'") fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "

") fString = Replace(fString, CHR(10), "
") fString=Dvbbs.ChkBadWords(fString) dvHTMLEncode = fString End If End Function Function reUBBCode(strContent) Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True strContent=replace(strContent," "," ") re.Pattern="(\[QUOTE\])(.[^\[]*)(\[\/QUOTE\])" strContent=re.Replace(strContent,"$2") re.Pattern="(\[point=*([0-9]*)\])(.[^\[]*)(\[\/point\])" strContent=re.Replace(strContent," ") re.Pattern="(\[post=*([0-9]*)\])(.[^\[]*)(\[\/post\])" strContent=re.Replace(strContent," ") re.Pattern="(\[power=*([0-9]*)\])(.[^\[]*)(\[\/power\])" strContent=re.Replace(strContent," ") re.Pattern="(\[usercp=*([0-9]*)\])(.[^\[]*)(\[\/usercp\])" strContent=re.Replace(strContent," ") re.Pattern="(\[money=*([0-9]*)\])(.[^\[]*)(\[\/money\])" strContent=re.Replace(strContent," ") re.Pattern="(\[replyview\])(.[^\[]*)(\[\/replyview\])" strContent=re.Replace(strContent," ") re.Pattern="(\[usemoney=*([0-9]*)\])(.[^\[]*)(\[\/usemoney\])" strContent=re.Replace(strContent," ") re.Pattern="\[username=(.[^\[]*)\](.[^\[]*)\[\/username\]" strContent=re.Replace(strContent," ") strContent=replace(strContent,"","") set re=Nothing reUBBCode=strContent End Function '截取指定字符 Function cutStr(str,strlen) '去掉所有HTML标记 Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="<(.[^>]*)>" str=re.Replace(str,"") set re=Nothing str=Replace(str,chr(10),"") str = Dvbbs.HTMLEncode(str) Dim l,t,c,i l=Len(str) t=0 For i=1 to l c=Abs(Asc(Mid(str,i,1))) If c>255 Then t=t+2 Else t=t+1 End If If t>=strlen Then cutStr=left(str,i)&"..." Exit For Else cutStr=str End If Next End Function %>