% Response.Expires=0 If Dvbbs.BoardID = 0 Then Response.Write "参数错误" Response.End End If If Dvbbs.GroupSetting(2)="0" Then Response.Write "" 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 "" 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=server.createobject("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
%>