<%
'最后修改2005.10.12，优化ubb性能，解决部分错误 By Winder.F
Dim UserPointInfo(4)
'UBB代码勘套循环的最多次数，避免死循环加入此变量
Const MaxLoopcount=100
'部分服务器vbscript可能不支持SubMatches集合，请设置 Issupport=0
Const Issupport=1
'签名最大字体值
Const Maxsize=4
%>
<script language=vbscript runat=server>
Dim Ubblists
'[/img]编号:1.[/upload]编号:2.[/dir]编号:3.[/qt]编号:4.[/mp]编号:5.
'[/rm]编号:6.[/sound]编号:7.[/flash]编号:8.[/money]编号:9.[/point]编号:10.
'[/usercp]编号:11.[/power]编号:12.[/post]编号:13.[/replyview]编号:14.[/usemoney]编号:15.
'[/url]编号:16.[/email]编号:17.http编号:18.https编号:19.ftp编号:20.rtsp编号:21.
'mms编号:22.[/html]编号:23.[/code]编号:24.[/color]编号:25.[/face]编号:26.[/align]编号:27.
'[/quote]编号:28.[/fly]编号:29.[/move]编号:30.[/shadow]编号:31.[/glow]编号:32.[/size]编号:33.
'[/i]编号:34.[/b]编号:35.[/u]编号:36.[em编号:37.www.编号:38.[/payto]编号:40.[/username]编号:41.[/center]编号:42.

Class Dvbbs_UbbCode
Public Re,reed,isgetreed,Board_Setting,WapPushUrl
Public Property Let PostType(ByVal vNewValue)
If PostType=2 Then
Board_Setting=Split("1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1",",")
Board_Setting(6)=1
Board_Setting(5)=0:Board_Setting(7)=1
Board_Setting(8)=1:Board_Setting(9)=1
Board_Setting(10)=0:Board_Setting(11)=0
Board_Setting(12)=0:Board_Setting(13)=0
Board_Setting(14)=0:Board_Setting(15)=0
Board_Setting(23)=0:Board_Setting(44)=0
Else
If Dvbbs.BoardID >0 Then 
Board_Setting=Dvbbs.Board_Setting
Else
Board_Setting=Split("1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1",",")
Board_Setting(6)=1
Board_Setting(5)=0:Board_Setting(7)=1
Board_Setting(8)=1:Board_Setting(9)=1
Board_Setting(10)=0:Board_Setting(11)=0
Board_Setting(12)=0:Board_Setting(13)=0
Board_Setting(14)=0:Board_Setting(15)=0
Board_Setting(23)=0:Board_Setting(44)=0
End If
End If
End Property
Private Sub Class_Initialize()
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
If Dvbbs.UserID=0 Then
UserPointInfo(0)=0:UserPointInfo(1)=0:UserPointInfo(2)=0:UserPointInfo(3)=0:UserPointInfo(4)=0
Else
UserPointInfo(0)=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text)
UserPointInfo(1)=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text)
UserPointInfo(2)=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text)
UserPointInfo(3)=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text)
UserPointInfo(4)=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)
End If
End Sub
Private Sub class_terminate()
Set Re=Nothing
End Sub
'超贴内容部分UBBCODE，入口：内容、用户等级ID、模式(1=帖子/2=公告、短信等)、模式2(0=新版/1=老版)
Public Function Dv_UbbCode(s,PostUserGroup,PostType,sType)
Dim ii,ranNum
Dim po
If (Not InStr(Ubblists,",39,")>0) Or Ubblists="" Or IsNull(Ubblists)  Then'老贴子
re.Pattern="<"
s= re.Replace(s,"&lt;")
're.Pattern="([^\x0d])\x0a"
's= re.Replace(s,"$1<br>")
're.Pattern="\x0d\x0a([^\x0d]*)" 
's= re.Replace(s,"<p>$1</p>")
End If
re.Pattern="(<s+cript(.[^>]*)>)"
s=re.Replace(s,"&lt;&#83cript$2&gt;")
re.Pattern="(<\/s+cript>)"
s=re.Replace(s,"&lt;/&#83cript&gt;")
re.Pattern="<\/p>\x0d?\x0a<p>" 
s= re.Replace(s,"<p></p>")
re.Pattern="([^\x0d])\x0a((?!<td|<tr))"
s= re.Replace(s,"$1<br>$2")
re.Pattern="\x0d\x0a([^\x0d]*)" 
s= re.Replace(s,"<p>$1</p>")
re.Pattern="\x02"
s= re.Replace(s,"<tr")
re.Pattern="(<body(.[^>]*)>)"
s=re.Replace(s,"<body>")
re.Pattern="(<\!(.[^>]*)>)"
s=re.Replace(s,"&lt;$2&gt;")
re.Pattern="(<\!)"
s=re.Replace(s,"&lt;!")
re.Pattern="(-->)"
s=re.Replace(s,"--&gt;")
re.Pattern="(javascript:)"
s=re.Replace(s,"<i>javascript</i>:")
re.Pattern="(<br>\s*){10,}"
s=re.Replace(s,"<br>")
If Board_Setting(5)="0" Then
re.Pattern="<(\/?(i|b|p))>"
s=re.Replace(s,Chr(1)&"$1"&Chr(2))
re.Pattern="(>)("&vbNewLine&"){1,2}(<)"
s=re.Replace(s,"$1$3")
're.Global=False
re.Pattern="(<div class=quote>)((.|\n)*?)(<\/div>)"
Do While re.Test(s)
s=re.Replace(s,"[quote]$2[/quote]")
Loop
're.Global=True
re.Pattern = "(<\/tr>)"
s = re.Replace(s,"[br]")
re.Pattern = "(<br>)"
s = re.Replace(s,"[br]")
re.Pattern = "<(\/?s(ub|up|trike))>"
s = re.Replace(s,"[$1]")
re.Pattern = "(<)(\/?font[^>]*)(>)"
s = re.Replace(s,CHR(1)&"$2"&CHR(2))
re.Pattern="<([^<>]*?)>"
Do while re.Test(s)
s=re.Replace(s,"")
Loop
re.Pattern = "(\x01)(\/?font[^\x02]*)(\x02)"
s = re.Replace(s,"<$2>")
re.Pattern = "\[(\/?s(ub|up|trike))\]"
s = re.Replace(s,"<$1>")
're.Global=False
re.Pattern="(\[quote\])((.|\n)*?)(\[\/quote\])"
Do While re.Test(s)
s=re.Replace(s,"<div class=quote>$2</div>")
Loop
're.Global=True
re.Pattern="\x01(\/?(i|b|p))\x02"
s=re.Replace(s,"<$1>")
re.Pattern = "(\[br\])"
s = re.Replace(s,"<br>")
If PostType=1 Then
re.Pattern=",[13-8],"
If re.Test(Ubblists) Then
If Dv_FilterJS(s) Then
re.Pattern="\[(br)\]"
s=re.Replace(s,"<$1>")
re.Pattern = "(<br>)"
s = re.Replace(s,vbNewLine)
re.Pattern = "(<p>)"
s = re.Replace(s,"")
re.Pattern = "(<\/p>)"
s = re.Replace(s,vbNewLine)
s=server.htmlencode(s)
s="<form name=""scode"&replyid&""" method=""post"" action=""""><table class=tableborder2 cellSpacing=1 cellPadding=3 width=""100%"" align=center border=""0""><TR><TH height=22>以下内容含脚本,或可能导致页面不正常的代码</TH></TR><TR><TD class=tablebody1 align=""middle"" width=""98%""><TEXTAREA id=CodeText style=""BORDER-RIGHT: 1px dotted; BORDER-TOP: 1px dotted; OVERFLOW-Y: visible; OVERFLOW: visible; BORDER-LEFT: 1px dotted; WIDTH: 98%; COLOR: #000000; BORDER-BOTTOM: 1px dotted"" rows=20 cols=120>"&s&"</TEXTAREA></TD></TR><TR><TD class=tablebody2 align=""middle"" width=""98%""><b>说明：</b>上面显示的是代码内容。您可以先检查过代码没问题，或修改之后再运行.</td></tr><TR><TD class=tablebody1 align=""middle"" width=""98%""><input type=""button"" name=""run"" value=""运行代码"" onclick=""Dvbbs_ViewCode("&replyid&");""></TD></TR></table></form>"
Dv_UbbCode=s
Exit Function
End If
End If
End If
Else
If PostType=1 Then
re.Pattern=",[13-8],"
If re.Test(Ubblists&"") Then
If Dv_FilterJS(s) Then
re.Pattern="\[(br)\]"
s=re.Replace(s,"<$1>")
re.Pattern = "(<br>)"
s = re.Replace(s,vbNewLine)
re.Pattern = "(<p>)"
s = re.Replace(s,"")
re.Pattern = "(<\/p>)"
s = re.Replace(s,vbNewLine)
s=server.htmlencode(s)
s="<form name=""scode"&replyid&""" method=""post"" action=""""><table class=tableborder2 cellSpacing=1 cellPadding=3 width=""100%"" align=center border=""0""><TR><TH height=22>以下内容含脚本,或可能导致页面不正常的代码</TH></TR><TR><TD class=tablebody1 align=""middle"" width=""98%""><TEXTAREA id=CodeText style=""BORDER-RIGHT: 1px dotted; BORDER-TOP: 1px dotted; OVERFLOW-Y: visible; OVERFLOW: visible; BORDER-LEFT: 1px dotted; WIDTH: 98%; COLOR: #000000; BORDER-BOTTOM: 1px dotted"" rows=20 cols=120>"&s&"</TEXTAREA></TD></TR><TR><TD class=tablebody2 align=""middle"" width=""98%""><b>说明：</b>上面显示的是代码内容。您可以先检查过代码没问题，或修改之后再运行.</td></tr><TR><TD class=tablebody1 align=""middle"" width=""98%""><input type=""button"" name=""run"" value=""运行代码"" onclick=""Dvbbs_ViewCode("&replyid&");""></TD></TR></table></form>"
s = Replace(s, vbNewLine, "")
s = Replace(s, CHR(10), "")
s = Replace(s, CHR(13), "")
Dv_UbbCode=s
Exit Function
End If
End If
End If
re.Pattern="<((asp|\!|%))"
s=re.Replace(s,"&lt;$1")
End If
're.Pattern="(<br>)"
's=re.Replace(s,"[br]")
re.Pattern="\[(br)\]"
s=re.Replace(s,"<$1>")
s = Replace(s, "", "&nbsp;")
s = Replace(s, "  ", "&nbsp;&nbsp;")
re.Pattern="<(\w+)(&nbsp;)+([^>]*)>"
s = re.Replace(s,"<$1 $3>")
If InStr(Ubblists,",39,")>0 And (InStr(Ubblists,",table,")>0 Or InStr(Ubblists,",td,")>0 Or InStr(Ubblists,",th,")>0 Or InStr(Ubblists,",tr,")>0 ) Then
s = server.htmlencode(s)
s="<form name=""scode"&replyid_a&""" method=""post"" action=""""><table class=tableborder2 cellSpacing=1 cellPadding=3 width=""100%"" align=center border=""0""><TR><TH height=22>以下内容含错误标记</TH></TR><TR><TD class=tablebody1 align=""middle"" width=""98%""><TEXTAREA id=CodeText style=""BORDER-RIGHT: 1px dotted; BORDER-TOP: 1px dotted; OVERFLOW-Y: visible; OVERFLOW: visible; BORDER-LEFT: 1px dotted; WIDTH: 98%; COLOR: #000000; BORDER-BOTTOM: 1px dotted"" rows=20 cols=120>"&s&"</TEXTAREA></TD></TR><TR><TD class=tablebody2 align=""middle"" width=""98%""><input type=""button"" name=""run"" value=""在新窗口中查看"" onclick=""Dvbbs_ViewCode("&replyid_a&");""></TD></TR></table></form>"
Dv_UbbCode=s
Exit Function
End If

'img code
'If Dvbbs.Forum_ChanSetting(0)="1" then WapPushUrl = "<br /><a href=""wap.asp?Action=readme&t=$1"" target=""_blank""><font class=redfont>发送图片到手机</font></a>"
'去掉图片中的脚本代码
re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"
s=re.replace(s,"<img src=$2 onclick=""javascript:window.open(this.src);"" style=""cursor: pointer"">" & WapPushUrl)
If (Trim(UbbLists)=",39," Or Trim(UbbLists)=",39,40,") And Not InStr(Lcase(s),"[username")>0 Then 
Dv_UbbCode=s
Exit Function
End If
If InStr(Ubblists,",1,")>0 Or sType=1 Then s=Dv_UbbCode_iS2(s,"img","<a onfocus=this.blur() href=""$1"" target=_blank title=新窗口打开><img src=""$1"" border=0 ></a>","<img src=""skins/default/filetype/gif.gif"" border=0><a onfocus=this.blur() href=""$1"" target=_blank>$1</a>",PostUserGroup,Cint(Board_Setting(7)),"")
'upload code
If InStr(Ubblists,",2,")>0 Or sType=1 Then s=Dv_UbbCode_U(s,PostUserGroup,Cint(Board_Setting(7)))

'media code
If InStr(Ubblists,",3,")>0 Or sType=1 Then s=Dv_UbbCode_iS2(s,"DIR","<object classid=clsid:166B1BCA-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=$1 height=$2><param name=src value=$3><embed src=$3 pluginspage=http://www.macromedia.com/shockwave/download/ width=$1 height=$2></embed></object>","<a href=$3 target=_blank>$3</a>",PostUserGroup,Cint(Board_Setting(9)),"=*([0-9]*),*([0-9]*)")

If InStr(Ubblists,",4,")>0 Or sType=1 Then s=Dv_UbbCode_iS2(s,"QT","<embed src=$3 width=$1 height=$2 autoplay=true loop=false controller=true playeveryframe=false cache=false scale=TOFIT bgcolor=#000000 kioskmode=false targetcache=false pluginspage=http://www.apple.com/quicktime/>","<a href=$3 target=_blank>$3</a>",PostUserGroup,Cint(Board_Setting(9)),"=*([0-9]*),*([0-9]*)")

If InStr(Ubblists,",5,")>0 Or sType=1 Then
s=Dv_UbbCode_iS2(s,"mp","<object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 ><param name=ShowStatusBar value=-1><param name=Filename value=$3><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=""$3"" width=$1 height=$2></embed></object>","<a href=""$3"" target=_blank>$3</a>",PostUserGroup,Cint(Board_Setting(9)),"=*([0-9]*),*([0-9]*)")
'Dv7 MediaPlayer自定义播放模式；
s=Dv_UbbCode_iS2(s,"mp","<object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=$1 height=$2 ><param name=AUTOSTART VALUE=$3 ><param name=ShowStatusBar value=-1><param name=Filename value=$4><embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=""$4"" width=$1 height=$2></embed></object>","<a href=""$4"" target=_blank>$4</a>",PostUserGroup,Cint(Board_Setting(9)),"=*([0-9]*),*([0-9]*),*([0|1|true|false]*)")
End If

If InStr(Ubblists,",6,")>0 Or sType=1 Then
s=Dv_UbbCode_iS2(s,"rm","<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><param name=SRC VALUE=""$3""><param name=CONSOLE VALUE=Clip1><param name=CONTROLS VALUE=imagewindow><param name=AUTOSTART VALUE=true></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1><param name=SRC VALUE=""$3""><param name=AUTOSTART VALUE=-1><param name=CONTROLS VALUE=controlpanel><param name=CONSOLE VALUE=Clip1></OBJECT>","<a href=$3 target=_blank>$3</a>",PostUserGroup,Cint(Board_Setting(9)),"=*([0-9]*),*([0-9]*)")
'Dv7 RealPlayer自定义播放模式；
s=Dv_UbbCode_iS2(s,"rm","<OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2><param name=SRC VALUE=""$4""><param name=CONSOLE VALUE=""$4""><param name=CONTROLS VALUE=imagewindow><param name=AUTOSTART VALUE=$3 ></OBJECT><br><OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=""video"" width=$1><param name=SRC VALUE=""$4""><param name=AUTOSTART VALUE=$3><param name=CONTROLS VALUE=controlpanel><param name=CONSOLE VALUE=""$4""></OBJECT>","<a href=$4 target=_blank>$4</a>",PostUserGroup,Cint(Board_Setting(9)),"=*([0-9]*),*([0-9]*),*([0|1|true|false]*)")
End If

If InStr(Ubblists,",7,")>0 Or sType=1 Then s=Dv_UbbCode_iS2(s,"sound","<a href=""$1"" target=_blank><img src=skins/default/filetype/mid.gif border=0 alt=""背景音乐""></a><bgsound src=""$1"" loop=""-1"">","<a href=$1 target=_blank>$1</a>",PostUserGroup,Cint(Board_Setting(9)),"")

'flash code
If InStr(Ubblists,",8,")>0 Or sType=1 Then
s=Dv_UbbCode_iS2(s,"flash","<a href=""$1"" target=_blank><img src=skins/default/filetype/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><param name=movie VALUE=""$1""><param name=quality VALUE=high><embed src=""$1"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$1</embed></OBJECT>","<img src=""skins/default/filetype/swf.gif"" border=""0""> <a href=$1 target=_blank>$1</a>",PostUserGroup,Cint(Board_Setting(44)),"")
s=Dv_UbbCode_iS2(s,"flash","<a href=""$3"" target=_blank><img src=skins/default/filetype/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=$1 height=$2><param name=movie VALUE=""$3""><param name=quality VALUE=high><embed src=""$3"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$1 height=$2>$3</embed></OBJECT>","<a href=$3 target=_blank>$3</a>",PostUserGroup,Cint(Board_Setting(44)),"=*([0-9]*),*([0-9]*)")
End If
'point view
If InStr(Ubblists,",9,")>0 Or sType=1 Then s=Dv_UbbCode_Get(s,PostUserGroup,PostType,"money","<hr size=""1""><font color=""gray"">以下内容需要超元数达到<b>$1</b>才可以浏览</font><br />$2<hr size=""1"">","<hr size=""1""><font color="&Dvbbs.Mainsetting(1)&">以下内容需要超元数达到<b>$1</b>才可以浏览</font><hr size=""1"">",UserPointInfo(0),Cint(Board_Setting(10)))
If InStr(Ubblists,",10,")>0 Or sType=1 Then s=Dv_UbbCode_Get(s,PostUserGroup,PostType,"point","<hr size=""1""><font color=""gray"">以下内容需要超元达到<b>$1</b>才可以浏览</font><br>$2<hr size=""1"">","<hr size=""1""><font color="&Dvbbs.Mainsetting(1)&">以下内容需要超元达到<b>$1</b>才可以浏览</font><hr size=""1"">",UserPointInfo(1),Cint(Board_Setting(11)))
If InStr(Ubblists,",11,")>0 Or sType=1 Then s=Dv_UbbCode_Get(s,PostUserGroup,PostType,"UserCP","<hr size=""1""><font color=""gray"">以下内容需要威望达到<b>$1</b>才可以浏览</font><br>$2<hr size=""1"">","<hr size=""1""><font color="&Dvbbs.Mainsetting(1)&">以下内容需要威望达到<b>$1</b>才可以浏览</font><hr size=""1"">",UserPointInfo(2),Cint(Board_Setting(12)))
If InStr(Ubblists,",12,")>0 Or sType=1 Then s=Dv_UbbCode_Get(s,PostUserGroup,PostType,"Power","<hr size=""1""><font color=""gray"">以下内容需要威望达到<b>$1</b>才可以浏览</font><br>$2<hr size=""1"">","<hr size=""1""><font color="&Dvbbs.Mainsetting(1)&">以下内容需要威望达到<b>$1</b>才可以浏览</font><hr size=""1"">",UserPointInfo(3),Cint(Board_Setting(13)))
If InStr(Ubblists,",13,")>0 Or sType=1 Then s=Dv_UbbCode_Get(s,PostUserGroup,PostType,"Post","<hr size=""1""><font color=""gray"">以下内容需要帖子数达到<b>$1</b>才可以浏览</font><br>$2<hr size=""1"">","<hr size=""1""><font color="&Dvbbs.Mainsetting(1)&">以下内容需要帖子数达到<b>$1</b>才可以浏览</font><hr size=""1"">",UserPointInfo(4),Cint(Board_Setting(14)))
If InStr(Ubblists,",14,")>0 Or sType=1 Then s=UBB_REPLYVIEW(s,PostUserGroup,PostType)
If InStr(Ubblists,",15,")>0 Or sType=1 Then s=UBB_USEMONEY(s,PostUserGroup,PostType)
'url code
If InStr(Ubblists,",16,")>0 Or sType=1 Then
s=Dv_UbbCode_S1(s,"url","<a href=""$1"" target=_blank>$1</a>")
s=Dv_UbbCode_UF(s,"url","<a href=""$1"" target=_blank>$2</a>","0")
End If
'email code
If InStr(Ubblists,",17,")>0 Or sType=1 Then
s=Dv_UbbCode_S1(s,"email","<img align=absmiddle src=skins/default/email1.gif ><a href=""mailto:$1"">$1</a>")
s=Dv_UbbCode_UF(s,"email","<img align=absmiddle src=skins/default/email1.gif ><a href=""mailto:$1"" target=_blank>$2</a>","0")
End If
If InStr(Ubblists,",37,")>0 Or sType=1 Then
If (Cint(Board_Setting(8)) = 1 Or PostUserGroup<4) And InStr(Lcase(s),"[em")>0 Then
re.Pattern="\[em([0-9]+)\]"
s=re.Replace(s,"<img src="""&EmotPath&"em$1.gif"" border=""0"" align=""middle"">")
End If
End If
If InStr(Ubblists,",23,")>0 Or sType=1 Then s=Dv_UbbCode_C(s,"html")
If InStr(Ubblists,",24,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"code","<div class=htmlcode><b>以下内容为程序代码:</b><br>$1</div>")
If InStr(Ubblists,",25,")>0 Or sType=1 Then s=Dv_UbbCode_UF(s,"color","<font color=$1>$2</font>","1")
If InStr(Ubblists,",26,")>0 Or sType=1 Then s=Dv_UbbCode_UF(s,"face","<font face=$1>$2</font>","1")
If InStr(Ubblists,",27,")>0 Or sType=1 Then s=Dv_UbbCode_Align(s)
If InStr(Ubblists,",42,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"center","<div align=center>$1</div>")
If InStr(Ubblists,",28,")>0 Or sType=1 Then s=Dv_UbbCode_Q(s)
If InStr(Ubblists,",29,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"fly","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
If InStr(Ubblists,",30,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"move","<MARQUEE scrollamount=3>$1</marquee>")
If InStr(Ubblists,",31,")>0 Or sType=1 Then s=Dv_UbbCode_iS1(s,"shadow","<div style=""width:$1px;filter:shadow(color=$2, strength=$3)"">$4</div>")
If InStr(Ubblists,",32,")>0 Or sType=1 Then s=Dv_UbbCode_iS1(s,"glow","<div style=""width:$1px;filter:glow(color=$2, strength=$3)"">$4</div>")
If InStr(Ubblists,",33,")>0 Or sType=1 Then s=Dv_UbbCode_UF(s,"size","<font size=$1>$2</font>","1")
If InStr(Ubblists,",34,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"i","<i>$1</i>")
If InStr(Ubblists,",35,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"b","<b>$1</b>")
If InStr(Ubblists,",36,")>0 Or sType=1 Then s=Dv_UbbCode_S1(s,"u","<u>$1</u>")
If InStr(Ubblists,",41,")>0 Or sType=1 Then s= Dv_UbbCode_name(s)
'如果没有更新过帖子数据，而定员帖失效的，请把下面的注释去掉，建议进行帖子数据更新，以提高性能 2005.10.10 By Winder.F
'If InStr(Lcase(s),"[username")>0 Then s= Dv_UbbCode_name(s)
If InStr(s,"payto:") = 0 Then s = Replace(s,"https://www.chaotie.com/payt","https://www.chaotie.com/payto:")
If InStr(Ubblists,",40,")>0 Then s=Dv_Alipay_PayTo(s)
'不开放HTML支持，不转换HREF
'If Board_Setting(5)="1" Then
'自动识别网址
If InStr(Ubblists,",18,")>0 Or InStr(Ubblists,",19,")>0 Or InStr(Ubblists,",20,")>0 Or InStr(Ubblists,",21,")>0 Or InStr(Ubblists,",22,")>0 Or sType=1 Then
re.Pattern = "(^|[^<=""])(((http|https|ftp|rtsp|mms):(\/\/|\\\\))(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+)"
s = re.Replace(s,"$1<a target=_blank href=$2>$2</a>")
End If
'自动识别www等开头的网址
If InStr(Ubblists,",38,")>0 Or sType=1 Then
re.Pattern = "(^|[^\/\\\w\=])((www|bbs)\.(\w)+\.([\w\/\\\.\=\?\+\-~`@\'!%#]|(&amp;))+)"
s = re.Replace(s,"$1<a target=_blank href=http://$2>$2</a>")
End If
'End If
's = Replace(s,"src=""http://www.chaotie.com/images/alipay.gif"" border=""0"" onclick=""javascript:window.open(this.src);""","src=""http://www.chaotie.com/images/alipay.gif"" border=""0""")
s=bbimg(s,550)
Dv_UbbCode = s
End Function
Private Function bbimg(strText,ssize)
Dim s
s=strText
re.Pattern="<img(.[^>]*)>"
If ssize=550 Then
s=re.replace(s,"<img$1 onload=""return imgzoom(this,"&ssize&")"">")
Else
s=re.replace(s,"<img$1 onload=""javascript:if(this.width>"& ssize &")this.style.width="&ssize&";if(this.height>250)this.style.width=(this.width*250)/this.height;"">")
End If
bbimg=s
End Function
'签名UBB转换
Public Function Dv_SignUbbCode(s,PostUserGroup)
Dim ii
Dim po
If Dvbbs.forum_setting(66)="0" Then 
s= server.htmlEncode(s)
re.Pattern="\[\/(?:img|dir|qt|mp|rm|sound|flash)\]"
If re.Test(s) Then
If Dv_FilterJS2(s)Then
re.Pattern="\[(br)\]"
s=re.Replace(s,"<$1>")
re.Pattern = "(&nbsp;)"
s = re.Replace(s,Chr(9))
re.Pattern = "(<br>)"
s = re.Replace(s,vbNewLine)
re.Pattern = "(<p>)"
s = re.Replace(s,"")
re.Pattern = "(<\/p>)"
s = re.Replace(s,vbNewLine)
s=server.htmlencode(s)
s="<form name=""scode"&replyid&""" method=""post"" action=""""><table class=tableborder2 cellSpacing=1 cellPadding=3 width=""100%"" align=center border=""0""><TR><TH height=22>以下内容含脚本,或可能导致页面不正常的代码</TH></TR><TR><TD class=tablebody1 align=""middle"" width=""98%""><TEXTAREA id=CodeText style=""BORDER-RIGHT: 1px dotted; BORDER-TOP: 1px dotted; OVERFLOW-Y: visible; OVERFLOW: visible; BORDER-LEFT: 1px dotted; WIDTH: 98%; COLOR: #000000; BORDER-BOTTOM: 1px dotted"" rows=20 cols=120>"&s&"</TEXTAREA></TD></TR><TR><TD class=tablebody2 align=""middle"" width=""98%""><b>说明：</b>上面显示的是代码内容。您可以先检查过代码没问题，或修改之后再运行.</td></tr><TR><TD class=tablebody1 align=""middle"" width=""98%""><input type=""button"" name=""run"" value=""运行代码"" onclick=""Dvbbs_ViewCode("&replyid&");""></TD></TR></table></form>"
s = Replace(s, vbNewLine, "")
s = Replace(s, Chr(10), "")
s = Replace(s, Chr(13), "")
Dv_SignUbbCode=s
Exit Function
End If
End If
re.Pattern="([^"&Chr(13)&"])"& Chr(10)
s= re.Replace(s,"$1<br />")
re.Pattern=Chr(13)&Chr(10)&"(.*)" 
s= re.Replace(s,"<p>$1</p>")
Else
re.Pattern="\[\/(?:img|dir|qt|mp|rm|sound|flash)\]"
If re.Test(s) Then
If Dv_FilterJS(s) Then
re.Pattern="\[(br)\]"
s=re.Replace(s,"<$1>")
re.Pattern = "(&nbsp;)"
s = re.Replace(s,Chr(9))
re.Pattern = "(<br>)"
s = re.Replace(s,vbNewLine)
re.Pattern = "(<p>)"
s = re.Replace(s,"")
re.Pattern = "(<\/p>)"
s = re.Replace(s,vbNewLine)
s=server.htmlencode(s)
s="<form name=""scode"&replyid&""" method=""post"" action=""""><table class=tableborder2 cellSpacing=1 cellPadding=3 width=""100%"" align=center border=""0""><TR><TH height=22>以下内容含脚本,或可能导致页面不正常的代码</TH></TR><TR><TD class=tablebody1 align=""middle"" width=""98%""><TEXTAREA id=CodeText style=""BORDER-RIGHT: 1px dotted; BORDER-TOP: 1px dotted; OVERFLOW-Y: visible; OVERFLOW: visible; BORDER-LEFT: 1px dotted; WIDTH: 98%; COLOR: #000000; BORDER-BOTTOM: 1px dotted"" rows=20 cols=120>"&s&"</TEXTAREA></TD></TR><TR><TD class=tablebody2 align=""middle"" width=""98%""><b>说明：</b>上面显示的是代码内容。您可以先检查过代码没问题，或修改之后再运行.</td></tr><TR><TD class=tablebody1 align=""middle"" width=""98%""><input type=""button"" name=""run"" value=""运行代码"" onclick=""Dvbbs_ViewCode("&replyid&");""></TD></TR></table></form>"
Dv_SignUbbCode=s
Exit Function
End If
End If
re.Pattern="<((asp|\!|%))"
s=re.Replace(s,"&lt;$1")
re.Pattern="(>)("&vbNewLine&")(<)"
s=re.Replace(s,"$1$3") 
re.Pattern="(>)("&vbNewLine&vbNewLine&")(<)"
s=re.Replace(s,"$1$3") 
End If
s = Replace(s, "  ", "&nbsp;&nbsp;")
s = Replace(s, vbNewLine, "<br>")
s = Replace(s, Chr(13), "")
're.Pattern="\.asp"
's = re.Replace(s,"")
'常规设置不支持UBB代码，则退出
If Cint(Dvbbs.Forum_setting(65))=0 Then 
Dv_SignUbbCode=s
Exit Function
End If 
'img code
If InStr(Lcase(s),"[/img]")>0 Then  s=Dv_UbbCode_iS2(s,"img","<img src=""$1"" border=0 >","<img src=""skins/default/filetype/gif.gif"" border=0><a onfocus=this.blur() href=""$1"" target=_blank>$1</a>",PostUserGroup,Cint(Dvbbs.forum_setting(67)),"")
'media code
If InStr(Lcase(s),"[/sound]")>0 Then s=Dv_UbbCode_iS2(s,"sound","<a href=""$1"" target=_blank><img src=skins/default/filetype/mid.gif border=0 alt=""背景音乐""></a><bgsound src=""$1"" loop=""-1"">","<a href=$1 target=_blank>$1</a>",PostUserGroup,Cint(Board_Setting(9)),"")
'flash code
If InStr(Lcase(s),"[/flash]")>0 Then
s=Dv_UbbCode_iS2(s,"flash","<a href=""$1"" TARGET=_blank><img src=skins/default/filetype/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><param name=movie VALUE=""$1""><param name=quality VALUE=high><embed src=""$1"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$1</embed></OBJECT>","<img src=""skins/default/filetype/swf.gif"" border=0> <a href=$1 target=_blank>$1</a>（注意：Flash内容可能含有恶意代码）",PostUserGroup,Cint(Dvbbs.forum_setting(71)),"")
s=Dv_UbbCode_iS2(s,"flash","<a href=""$3"" TARGET=_blank><img src=skins/default/filetype/swf.gif border=0 alt=点击开新窗口欣赏该FLASH动画! height=16 width=16>[全屏欣赏]</a><br><OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=$1 height=$2><param name=movie VALUE=""$3""><param name=quality VALUE=high><embed src=""$3"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=$1 height=$2>$3</embed></OBJECT>","<a href=$3 target=_blank>$3</a>（注意：Flash内容可能含有恶意代码）",PostUserGroup,Cint(Dvbbs.forum_setting(71)),"=*([0-9]*),*([0-9]*)")
End If
'url code
If InStr(Lcase(s),"[/url]")>0 Then
s=Dv_UbbCode_S1(s,"url","<a href=""$1"" target=_blank>$1</a>")
s=Dv_UbbCode_UF(s,"url","<a href=""$1"" target=_blank>$2</a>","0")
End If
'email code
If InStr(Lcase(s),"[/email]")>0 Then
s=Dv_UbbCode_S1(s,"email","<img align=absmiddle src=skins/default/email1.gif ><a href=""mailto:$1"">$1</a>")
s=Dv_UbbCode_UF(s,"email","<img align=absmiddle src=skins/default/email1.gif ><a href=""mailto:$1"" target=_blank>$2</a>","0")
End If
If InStr(Lcase(s),"[/html]")>0 Then s=Dv_UbbCode_C(s,"html")
If InStr(Lcase(s),"[/color]")>0 Then s=Dv_UbbCode_UF(s,"color","<font color=$1>$2</font>","1")
If InStr(Lcase(s),"[/face]")>0 Then s=Dv_UbbCode_UF(s,"face","<font face=$1>$2</font>","1")
If InStr(Lcase(s),"[/align]")>0 Then s=Dv_UbbCode_Align(s)

If InStr(Lcase(s),"[/shadow]")>0 Then s=Dv_UbbCode_iS1(s,"shadow","<div style=""width:$1px;filter:shadow(color=$2, strength=$3)"">$4</div>")
If InStr(Lcase(s),"[/glow]")>0 Then s=Dv_UbbCode_iS1(s,"glow","<div style=""width:$1px;filter:glow(color=$2, strength=$3)"">$4</div>")
If InStr(Lcase(s),"[/i]")>0 Then s=Dv_UbbCode_S1(s,"i","<i>$1</i>")
If InStr(Lcase(s),"[/b]")>0 Then s=Dv_UbbCode_S1(s,"b","<b>$1</b>")
If InStr(Lcase(s),"[/u]")>0 Then s=Dv_UbbCode_S1(s,"u","<u>$1</u>")
If InStr(Lcase(s),"[/size]")>0 Then
s=Dv_UbbCode_UF(s,"size","<font size=$1>$2</font>","1-"&Maxsize&"")
End If
REM ：签名移动(如需使用则把以下屏蔽去掉)
'If InStr(Lcase(s),"[/fly]")>0 Then s=Dv_UbbCode_S1(s,"fly","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
'If InStr(Lcase(s),"[/move]")>0 Then s=Dv_UbbCode_S1(s,"move","<MARQUEE scrollamount=3>$1</marquee>")
'不开放HTML支持，不转换HREF
REM 加上签名是否开放HTML判断 2004-5-6 Dvbbs.YangZheng
If Board_Setting(5)="1" And Dvbbs.Forum_Setting(66) = "1" Then
'自动识别网址
If InStr(Lcase(s),"http://")>0 Then
re.Pattern = "(^|[^<=""])(http:(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+)"
s = re.Replace(s,"$1<a target=_blank href=$2>$2</a>")
End If
'自动识别www等开头的网址
If InStr(Lcase(s),"www.")>0 or InStr(Lcase(s),"bbs.")>0 Then
re.Pattern = "(^|[^\/\\\w\=])((www|bbs)\.(\w)+\.([\w\/\\\.\=\?\+\-~`@\'!%#]|(&amp;))+)"
s = re.Replace(s,"$1<a target=_blank href=http://$2>$2</a>")
End If
End If
s=bbimg(s,550)
Dv_SignUbbCode=s
End Function

Private Function Dv_UbbCode_S1(strText,uCodeC,tCode)
Dim s
s=strText
re.Pattern="\["&uCodeC&"\][\s\n]*\[\/"&uCodeC&"\]"
s=re.Replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s, Chr(1)&"/"&uCodeC&"]")
re.Pattern="\["&uCodeC&"\]([^\x01]*)\x01\/"&uCodeC&"\]"
s=re.Replace(s,tCode)
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s,"[/"&uCodeC&"]")
Dv_UbbCode_S1=s
End Function

Private Function Dv_UbbCode_UF(strText,uCodeC,tCode,Flag)
Dim s
Dim LoopCount
LoopCount=0
s=strText
re.Pattern="\["&uCodeC&"=([^\]]*)\][\s\n]*\[\/"&uCodeC&"\]"
s=re.Replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s, chr(1)&"/"&uCodeC&"]")
re.Pattern="\["&uCodeC&"=([^\]]*)\]([^\x01]*)\x01\/"&uCodeC&"\]"
If Flag="1" Then
Do While Re.Test(s)
s=re.Replace(s,tCode)
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit Do
Loop
ElseIf Flag="0" Then
s=re.Replace(s,tCode)
Else
re.Pattern="\["&uCodeC&"=(["&Flag&"]*)\]([^\x01]*)\x01\/"&uCodeC&"\]"
Do While Re.Test(s)
s=re.Replace(s,tCode)
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit Do
Loop
End If
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s,"[/"&uCodeC&"]")
Dv_UbbCode_UF=s
End Function

Private Function Dv_UbbCode_iS1(strText,uCodeC,tCode)
Dim s
s=strText
re.Pattern="\["&uCodeC&"=[^\]]*\][\s\n]\[\/"&uCodeC&"\]"
s=re.Replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s, chr(1)&"/"&uCodeC&"]")
re.Pattern="\["&uCodeC&"=([0-9]+),(#?[\w]+),([0-9]+)\]([^\x01]*)\x01\/"&uCodeC&"\]"
s=re.Replace(s,tCode)
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s, "[/"&uCodeC&"]")
Dv_UbbCode_iS1=s
End Function

Private Function Dv_UbbCode_iS2(strText,uCodeC,tCode1,tCode2,PostUserGroup,Flag,iCode)
Dim s
s=strText
re.Pattern="\["&uCodeC&iCode&"\][\s\n]*\[\/"&uCodeC&"\]"
s=re.replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s, chr(1)&"/"&uCodeC&"]")
If uCodeC="img" Then
re.Pattern="\[img\]([\/\\]*[^\/\\]*.asp[^\x01\n]*)\x01\/img\]"
s=re.Replace(s,"[img]$1[/img]")
re.Pattern="\[img\]( *http:[\/\\]*"&Replace(Request.ServerVariables("HTTP_HOST"),".","\.")&"[^\x01\n]*.asp[^\x01\n]*)\x01\/img\]"
s=re.Replace(s,"[img]$1[/img]")
End If
If uCodeC<>"flash" Then
re.Pattern="\["&uCodeC&iCode&"\]((?:[^\x01\n]*)(?:\.swf|\.swi)(?:[^\x01\n]*))\x01\/"&uCodeC&"\]"
s=re.Replace(s,"非法多媒体标签，文件地址：$1")
End If
re.Pattern="\["&uCodeC&iCode&"\]([^\x01\n]*)\x01\/"&uCodeC&"\]"
If Flag = 1 or PostUserGroup<4 Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If 
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s,"[/"&uCodeC&"]")
Dv_UbbCode_iS2=s
End Function

Private Function Dv_UbbCode_Align(strText)
Dim s
s=strText
re.Pattern="\[align=(center|left|right)\][\s\n]*\[\/align\]"
s=re.Replace(s,"")
re.Pattern="\[\/align\]"
s=re.replace(s,chr(1)&"/align]")
re.Pattern="\[align=(center|left|right)\]([^\x01]*)\x01\/align\]"
s=re.Replace(s,"<div align=$1>$2</div>")
re.Pattern="\x01\/align\]"
s=re.replace(s,"[/align]")
Dv_UbbCode_Align=s
End Function

Private Function Dv_UbbCode_U(strText,PostUserGroup,Flag)'(帖子内容，用户等级，是否开放图片标签)
Dim s
If Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UpFile/"
If right(Dvbbs.Forum_Setting(76),1)<>"/" Then Dvbbs.Forum_Setting(76)=Dvbbs.Forum_Setting(76)&"/"
s=strText
re.Pattern="\[upload=([^\]\n]*)\][\s\n]\[\/UPLOAD\]"
s=re.Replace(s,"")
re.Pattern="\[\/UPLOAD\]"
s=re.replace(s, chr(1)&"/upload]")
re.Pattern="\[upload=(gif|jpg|jpeg|bmp|png)\]UpFile/([^\x01\n]*)\x01\/UPLOAD\]"
If Dvbbs.Forum_Setting(75)="0" Then 
If Flag = 1 or PostUserGroup<4 Then
s= re.Replace(s,"<br><img src=""skins/default/filetype/$1.gif"" border=0 >此主题相关图片如下：<br><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=_blank id=""ImgSpan""><img src="""&Dvbbs.Forum_Setting(76)&"$2"" border=0 alt=按此在新窗口浏览图片 ></a>")
Else
s= re.Replace(s,"<br><img src=""skins/default/filetype/$1.gif"" border=0 ><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=_blank>"&Dvbbs.Forum_Setting(76)&"$2</a>")
End If 
Else
If Flag = 1 or PostUserGroup<4 Then
s= re.Replace(s,"<br><img src=""skins/default/filetype/$1.gif"" border=0 >此主题相关图片如下：<br><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=_blank id=""ImgSpan"" ><img src=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" border=0 alt=按此在新窗口浏览图片 ></a>")
Else
s= re.Replace(s,"<br><img src=""skins/default/filetype/$1.gif"" border=0 ><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=_blank>showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2</a>")
End If
End If
re.Pattern="\[upload=(swf|swi)\]([^\x01\n]*)\x01\/UPLOAD\]"
If Dvbbs.Forum_Setting(75)="0" Then 
If Board_Setting(44) = 1 or PostUserGroup<4 Then
s= re.Replace(s,"<br><img src=""skins/default/filetype/swf.gif"" border=0 ><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=_blank>点击浏览该FLASH文件</a>：<br><embed src="""&Dvbbs.Forum_Setting(76)&"$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=300></embed>")
Else
s= re.Replace(s,"<br><img src=""skins/default/filetype/swf.gif"" border=0 ><a href="""&Dvbbs.Forum_Setting(76)&"$2"" target=_blank>"&Dvbbs.Forum_Setting(76)&"$2</a>")
End If 
Else
If Flag = 1 or PostUserGroup<4 Then
s= re.Replace(s,"<br><img src=""skins/default/filetype/swf.gif"" border=""0""><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=_blank>点击浏览该FLASH文件</a>：<br><embed src=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=300></embed>")
Else
s= re.Replace(s,"<br><img src=""skins/default/filetype/$1.gif"" border=""0""><a href=""showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2"" target=_blank>showimg.asp?BoardID="&Dvbbs.BoardID&"&filename=$2</a>")
End If
End If
re.Pattern="\[upload=([^\]\n]+)\]viewFile\.asp\?id=([0-9]*)\x01\/UPLOAD\]"
s= re.Replace(s,"<img src=""skins/default/filetype/$1.gif"" border=""0""><a href=""viewFile.asp?BoardID="&Dvbbs.Boardid&"&ID=$2"" target=_blank>点击浏览该文件</a>")
re.Pattern="\x01\/upload]"
re.Pattern="\[upload=([^\]\n]+)\]([^\x01]*)\x01\/UPLOAD\]"
s= re.Replace(s,"<img src=""skins/default/filetype/$1.gif"" border=""0""><a href=""$2"" target=_blank>点击浏览该文件</a>")
re.Pattern="\x01\/upload]"
s=re.replace(s,"[/upload]")
Dv_UbbCode_U=s
End Function

Private Function Dv_UbbCode_Q(strText)
Dim s
Dim LoopCount
LoopCount=0
s=strText
're.Global=False
re.Pattern="\[quote\]((.|\n)*?)\[\/quote\]"
Do While re.Test(s)
s=re.Replace(s,"<div class=""quote"">$1</div>")
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit Do
Loop
're.Global=True
Dv_UbbCode_Q=s
End Function

Private Function Dv_UbbCode_name(strText)
Dim s
Dim po,match
s=strText
re.Pattern="\[\/username\]"
s=re.Replace(s,Chr(1)&"/username]")
re.Pattern="\[username=([^\]]+)]([^\x01]*)\x01\/username\]"
If Cint(Board_Setting(56))=1 Then
Set match = re.Execute(s)
If match.count>0 Then
po=re.Replace(match.item(0),",$1,")
If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or InStr(po,","&Dvbbs.Membername&",")>0 or Dvbbs.master) Then
s=re.Replace(s,"<hr /><font color=red>以下内容是专门发给<B>$1</B>浏览</font><BR>$2<hr />")
Else

s=re.Replace(s,"<hr /><font color=gray>以下内容是专门发给<B>$1</B>浏览</font><BR><hr />")
End If
End If
Else

s=re.Replace(s,"$2")
End If
re.Pattern="\x01\/username\]"
s=re.Replace(s,"[/username]")
Set match=Nothing
Dv_UbbCode_name=s
End Function

Private Function Dv_UbbCode_Get(strText,PostUserGroup,PostType,uCodeC,tCode1,tCode2,UsePoint,Flag)'帖子内容,发帖人组别,发帖类型,,,,,,用户超元,是否开放ubb标签
Dim s,ii,match
Dim LoopCount
s=strText
UsePoint=CLng(UsePoint)
re.Pattern="\["&uCodeC&"= *[0-9]*\][\s\n]*\[\/"&uCodeC&"\]"
s=re.replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s,Chr(1)&"/"&uCodeC&"]")
re.Pattern="\["&uCodeC&"= *([0-9]+)\]([^\x01]*)\x01\/"&uCodeC&"\]"
If Issupport=1 Then
Dim matches
Set matches = re.Execute(s)
re.Global=False
For Each match In matches
If (Flag=1 or PostUserGroup<4) and PostType=1 Then
ii=int(match.SubMatches(0))
If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or UsePoint>=ii or Dvbbs.master) Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If
Else
s=re.Replace(s,"$2")
End If
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit For
Next
Set matches=Nothing
Else
Dim Test
re.Global=False
Test=re.Test(s)
Do While Test
If (Flag=1 or PostUserGroup<4) and PostType=1 Then
Set match = re.Execute(s)
ii=int(re.Replace(match.item(0),"$1"))
If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or UsePoint>=ii or Dvbbs.master) Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If
Else
s=re.Replace(s,"$2")
End If
LoopCount=LoopCount+1
If LoopCount>MaxLoopCount Then Exit Do
Test=re.Test(s)
Loop
Set match=Nothing
End If
re.Global=True
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s,"[/"&uCodeC&"]")
Dv_UbbCode_Get=s
End Function

Private Function UBB_REPLYVIEW(strText,PostUserGroup,PostType)
Dim s
Dim vrs
s=strText
re.Pattern="\[replyview\][\s\n]*\[\/replyview\]"
s=re.Replace(s,"")
re.Pattern="\[\/replyview\]"
s=re.replace(s, chr(1)&"/replyview]")
re.Pattern="\[replyview\]([^\x01]*)\x01\/replyview\]"
If (Board_Setting(15)="1" or PostUserGroup<4) and PostType=1  Then
If isgetreed<>1 Then 
Set vrs=dvbbs.execute("select AnnounceID from "&TotalUseTable&" where rootid="&Announceid&" and PostUserID="&Dvbbs.UserID)
isgetreed=1
If Not vRs.eof Then
reed=1 
Else
reed=0
End If
Set vrs=Nothing
End If 
If Dvbbs.Membername<>"" and (reed=1 or Dvbbs.master) Then
s=re.Replace(s,"<hr noshade size=1><font color=gray>以下内容只有<B>回复</B>后才可以浏览</font><BR>$1<hr noshade size=1>")
Else
s=re.Replace(s,"<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容只有<B>回复</B>后才可以浏览</font><hr noshade size=1>")
End If 
Else
s=re.Replace(s,"$1")
End If 
re.Pattern="\x01\/replyview\]"
s=re.replace(s, "[/replyview]")
UBB_REPLYVIEW=s
End Function

Private Function UBB_USEMONEY(strText,PostUserGroup,PostType)
Dim s
Dim Test
Dim ii,iii,match,buied
Dim SplitBuyUser,iPostBuyUser
Dim LoopCount
s=strText
re.Global=False
re.Pattern="\[USEMONEY=*([0-9]+)\]((.|\n)*)\[\/USEMONEY\]"
Test=re.Test(s)
If Test Then
If T_GetMoneyType >0 Then
s=re.Replace(s,"<hr size=""1""><font color=""gray"">由于使用了贴币帖子设置，因此出售帖UBB模式失效，以下是帖子内容：</font>&nbsp;&nbsp;<br />$2<hr size=""1"">")
Else
If (Cint(Board_Setting(23))=1 or PostUserGroup<4) and PostType=1 Then
Set match = re.Execute(s)
ii=int(re.Replace(match.item(0),"$1"))
If  Dvbbs.Membername<>"" and (Dvbbs.Membername=UserName or Dvbbs.master) Then
If (Not IsNull(PostBuyUser)) And PostBuyUser<>"" Then
SplitBuyUser=split(PostBuyUser,"|")
iPostBuyUser="<option value=0>已购买用户</option>"
for iii=0 to ubound(SplitBuyUser)
iPostBuyUser=iPostBuyUser & "<option value="&iii&">"&SplitBuyUser(iii)&"</option>"
next
Else
iPostBuyUser="<option value=0>还没有用户购买</option>"
End If
s=re.Replace(s,"<hr noshade size=1><font color=gray>以下内容需要花费现金<B>$1</B>才可以浏览</font>&nbsp;&nbsp;<select size=1 name=buyuser>"&iPostBuyUser&"</select><br>$2<hr noshade size=1>")
re.Global=True
re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
s=re.Replace(s,"")
Else
buied=0
If (Not IsNull(PostBuyUser)) and PostBuyUser<>"" Then
If Instr("|"&PostBuyUser&"|","|"&Dvbbs.Membername&"|")>0 Then buied=1
End If
If buied=1 Then
s=re.Replace(s,"<hr noshade size=1><font color=gray>以下内容需要花费现金<B>$1</B>才可以浏览，您已经购买本帖</font><BR>$2<hr noshade size=1>")
re.Global=True
re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
s=re.Replace(s,"")
Else
If Clng(UserPointInfo(0))>=ii Then
s=re.Replace(s,"<Form action=""BuyPost.asp"" mothod=post><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<B>$1</B>才可以浏览，您目前有现金<b>"&UserPointInfo(0)&"</b>。<br><br>　　　　<input type=hidden name=boardid value="&Dvbbs.boardid&"><input type=hidden value="&replyid_a&" name=replyid><input type=hidden value="&AnnounceID_a&" name=id><input type=hidden value="&RootID_a&" name=rootid><input type=hidden value="&totalusetable&" name=posttable><input type=submit name=submit value=好黑啊…我…我买了！>&nbsp;&nbsp;</font></form>")
Else
s=re.Replace(s,"<hr noshade size=1><font color="&Dvbbs.Mainsetting(1)&">以下内容需要花费现金<b>$1</b>才可以浏览，您只有现金<b>"&UserPointInfo(0)&"</b>，无法购买。</font><hr noshade size=1>")
End If
End If
End If
Else
re.Global=True
re.Pattern="\[\/?USEMONEY=*[0-9]*\]"
s=re.Replace(s,"")
End If
Set match=Nothing
End If
End If
re.Global=True
UBB_USEMONEY=s
End Function

Public Function Dv_FilterJS(v)
If Not Isnull(V) Then
Dim t,test,Replacelist,t1
t=v
t1=v
re.Pattern="&#36;"
t1=re.Replace(t1,"$")
re.Pattern="&#36"
t1=re.Replace(t1,"$")
re.Pattern="&#39;"
t1=re.Replace(t1,"'")
re.Pattern="&#39"
t1=re.Replace(t1,"'")
If InStr(Dvbbs.forum_setting(77),"|")=0 Then 
Replacelist="(&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"
Else
Replacelist="("&Dvbbs.forum_setting(77)&"&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit|error|click|key|load|focus|Blur))"
End If
re.Pattern="<((.[^>]*"&Replacelist&"[^>]*)|"&Replacelist&")>"
Test=re.Test(t1)
If Test=False Then
If InStr(Dvbbs.forum_setting(77),"|")=0 Then 
'Replacelist="(&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit=|error|click|key|load|focus|Blur)|\[|\])"
Replacelist="(&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"
Else
Replacelist="("&Dvbbs.forum_setting(77)&"&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit|error|click|key|load|focus|Blur))"
End If
re.Pattern="(\[(.[^\]]*)\])((.[^\]]*"&Replacelist&"[^\]]*)|"&Replacelist&")(\[\/(.[^\]]*)\])"
Test=re.Test(t1)
End If
Dv_FilterJS=test
End If
End Function

Public Function Dv_FilterJS2(v)
If Not Isnull(V) Then
Dim t,test,Replacelist,t1
t=v
t1=v
re.Pattern="&#36;"
t1=re.Replace(t1,"$")
re.Pattern="&#36"
t1=re.Replace(t1,"$")
re.Pattern="&#39;"
t1=re.Replace(t1,"'")
re.Pattern="&#39"
t1=re.Replace(t1,"'")
If InStr(Dvbbs.forum_setting(77),"|")=0 Then 
Replacelist="(&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"'|\[|\]
Else
Replacelist="("&Dvbbs.forum_setting(77)&"&#([0-9][0-9]*)|function|meta|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie|on(finish|mouse|Exit|error|click|key|load|focus|Blur))"
End If
re.Pattern="(\[(.[^\]]*)\])((.[^\]]*"&Replacelist&"[^\]]*)|"&Replacelist&")(\[\/(.[^\]]*)\])"
Test=re.Test(t1)
Dv_FilterJS2=test
End If
End Function

Private Function Dv_UbbCode_C(strText,uCodeC)
Dim s,matches,match,CodeStr
s=strText
'Dim LoopCount
s=strText
re.Pattern="\["&uCodeC&"\][\s\n]*\[\/"&uCodeC&"\]"
s=re.replace(s,"")
re.Pattern="\[\/"&uCodeC&"\]"
s=re.replace(s,Chr(1)&"/"&uCodeC&"]")
re.Pattern="\["&uCodeC&"\]([^\x01]*)\x01\/"&uCodeC&"\]"
Set matches = re.Execute(s)
re.Global=False
For Each match In matches
CodeStr=match.SubMatches(0)
CodeStr = Replace(CodeStr,"&nbsp;",Chr(32),1,-1,1)
CodeStr = Replace(CodeStr,"<p>","",1,-1,1)
CodeStr = Replace(CodeStr,"</p>","&#13;&#10;",1,-1,1)
CodeStr = Replace(CodeStr,"[br]","&#13;&#10;",1,-1,1)
CodeStr = Replace(CodeStr,"<br>","&#13;&#10;",1,-1,1)
CodeStr = Replace(CodeStr,vbNewLine,"&#13;&#10;",1,-1,1)
CodeStr = "<form name=""scode"&replyid&""" method=""post"" action=""""><TABLE class=tableborder1 cellSpacing=1 cellPadding=3 style=""WIDTH: 98%;"" align=center><TR><TH height=22>以下是程序代码</TH></TR><TR><TD class=tablebody"&(((Floor+1) Mod 2)+1)&" align=middle width=""98%""><textarea id=CodeText style=""WIDTH: 100%;"" rows=10>"&CodeStr&"</TEXTAREA></TD></TR><TR><TD class=tablebody"&(((Floor+1) Mod 2)+1)&" align=middle width=""98%""><b>说明：</b>上面显示的是代码内容。您可以先检查过代码没问题，或修改之后再运行.</td></tr><TR><TD class=tablebody"&(((Floor+1) Mod 2)+1)&" align=middle width=""98%""><input type=""button"" name=""run"" value=""运行代码"" onclick=""Dvbbs_ViewCode2("&replyid&");"">&nbsp;<input type=""button"" name=""copy"" value=""复制代码"" onclick=""Dvbbs_CopyCode("&replyid&");"">&nbsp;<input type=""button"" name=""save"" value=""另存代码"" onclick=""Dvbbs_SaveCode("&replyid&");""></TD></TR></TABLE></form>"
s = re.Replace(s,CodeStr)
Next
Set matches=Nothing
re.Pattern="\x01\/"&uCodeC&"\]"
s=re.replace(s,"[/"&uCodeC&"]")
Dv_UbbCode_C=s
End Function

Private Function Dv_Alipay_PayTo(strText)
If Not Isnull(strText) Then
Dim s,ss
Dim match,match2,urlStr,re2
Dim t(2),temp,check,fee,i
s=strText
Set re2=new RegExp
re2.IgnoreCase =True
re2.Global=False
t(0)="卖家承担运费"
t(1)="买家承担运费"
t(2)="虚拟物品不需邮递"
s=strText
re.Pattern="\[\/payto\]"
s=re.replace(s, chr(1)&"/payto]")
re.Pattern="\[payto\]([^\x01]+)\x01\/payto\]"
Set match = re.Execute(s)
re.Global=False
For i=0 To match.count-1
re2.Pattern="\(seller\)([^\n]+?)\(\/seller\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
ss=""
urlStr="http://pay.sg188.com/payto.asp?seller="&temp
re2.Pattern="\(subject\)([^\n]+?)\(\/subject\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
ss=ss&"<br><b>商品名称</b>："&temp&"<br><br>"
urlStr=urlStr&"&subject="&temp
re2.Pattern="\(body\)((?:.|\n)*?)\(\/body\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
ss=ss&"<b>商品说明</b>："&temp&"<br><br>"
urlStr=urlStr&"&body="&temp
re2.Pattern="\(price\)([\d\.]+?)\(\/price\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
ss=ss&"<b>商品价格</b>："&temp&" 元<br><br>"
urlStr=urlStr&"&price="&temp
re2.Pattern="\(transport\)([1-3])\(\/transport\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
check=True
If int(temp)=2 Then
re2.Pattern="\(express_fee\)([\d\.]+?)\(\/express_fee\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
fee=re2.replace(match2.item(0),"$1")
ss=ss&"<b>邮递信息</b>："&t(temp-1)&"，快递 "&fee&" 元<br><br>"
urlStr=urlStr&"&transport="&temp&"&express_fee="&fee
Else
re2.Pattern="\(ordinary_fee\)([\d\.]+?)\(\/ordinary_fee\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
fee=re2.replace(match2.item(0),"$1")
ss=ss&"<b>邮递信息</b>："&t(temp-1)&"，平邮 "&fee&" 元<br><br>"
urlStr=urlStr&"&transport="&temp&"&ordinary_fee="&fee
Else
check=False
End If
End If
Else
ss=ss&"<b>邮递信息</b>："&t(temp-1)&"<br><br>"
urlStr=urlStr&"&transport="&temp
End If
If check=True Then
check=False
re2.Pattern="\(ww\)([^\n]+?)\(\/ww\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
ss=ss&"<b>联系方法</b>：<a target=""_blank"" href=""http://amos1.taobao.com/msg.ww?v=2&amp;uid="&EncodeUtf8(temp)&"&amp;s=1""><img border=""0"" src=""http://amos1.taobao.com/online.ww?v=2&amp;uid="&EncodeUtf8(temp)&"&amp;s=1""/></a>"
check=True
End If
re2.Pattern="\(qq\)(\d+?)\(\/qq\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
If check=True Then
ss=ss&"&nbsp;&nbsp;<a target=""_blank"" href=""http://wpa.qq.com/msgrd?V=1&Uin="&temp&"&Site=sg188.com&Menu=yes""><img border=""0"" SRC=""http://wpa.qq.com/pa?p=1:"&temp&":10"" alt=""联系我""></a><br><br>"
Else
ss=ss&"<b>联系方法</b>：<a target=""_blank"" href=""http://wpa.qq.com/msgrd?V=1&Uin="&temp&"&Site=sg188.com&Menu=yes""><img border=""0"" SRC=""http://wpa.qq.com/pa?p=1:"&temp&":10"" alt=""联系我""></a><br><br>"
End If
ElseIf check=True Then
ss=ss&"<br><br>"
End If
re2.Pattern="\(demo\)([^\n]+?)\(\/demo\)"
If re2.Test(match.item(i)) Then
Set match2 = re2.Execute(match.item(i))
temp=re2.replace(match2.item(0),"$1")
ss=ss&"<b>演示地址</b>："&temp&"<br><br>"
urlStr=urlStr&"&url="&temp
End If
ss=ss&"<br>"
s=re.replace(s,ss)
End If
End If
End If
End If
End If
End If
Next
Set match=Nothing
Set re2=Nothing
Set match2=Nothing
re.Global=True
re.Pattern="\x01\/payto\]"
s=re.replace(s,"[/payto]")
Dv_Alipay_PayTo=s
End If
End Function
End Class
</script>

<script type="text/javascript" runat="server" language=javascript>
 function EncodeUtf8(s1)
  {
      var s = escape(s1);
      var sa = s.split("%");
      var retV ="";
      if(sa[0] != "")
      {
         retV = sa[0];
      }
      for(var i = 1; i < sa.length; i ++)
      {
           if(sa[i].substring(0,1) == "u")
           {
               retV += Hex2Utf8(Str2Hex(sa[i].substring(1,5))) + sa[i].substring(5,sa[i].length);
               
           }
           else retV += "%" + sa[i];
      }
      
      return retV;
  }
  function Str2Hex(s)
  {
      var c = "";
      var n;
      var ss = "0123456789ABCDEF";
      var digS = "";
      for(var i = 0; i < s.length; i ++)
      {
         c = s.charAt(i);
         n = ss.indexOf(c);
         digS += Dec2Dig(eval(n));
           
      }
      //return value;
      return digS;
  }
  function Dec2Dig(n1)
  {
      var s = "";
      var n2 = 0;
      for(var i = 0; i < 4; i++)
      {
         n2 = Math.pow(2,3 - i);
         if(n1 >= n2)
         {
            s += '1';
            n1 = n1 - n2;
          }
         else
          s += '0';
          
      }
      return s;
      
  }
  function Dig2Dec(s)
  {
      var retV = 0;
      if(s.length == 4)
      {
          for(var i = 0; i < 4; i ++)
          {
              retV += eval(s.charAt(i)) * Math.pow(2, 3 - i);
          }
          return retV;
      }
      return -1;
  } 
  function Hex2Utf8(s)
  {
     var retS = "";
     var tempS = "";
     var ss = "";
     if(s.length == 16)
     {
         tempS = "1110" + s.substring(0, 4);
         tempS += "10" +  s.substring(4, 10); 
         tempS += "10" + s.substring(10,16); 
         var sss = "0123456789ABCDEF";
         for(var i = 0; i < 3; i ++)
         {
            retS += "%";
            ss = tempS.substring(i * 8, (eval(i)+1)*8);
            
            
            
            retS += sss.charAt(Dig2Dec(ss.substring(0,4)));
            retS += sss.charAt(Dig2Dec(ss.substring(4,8)));
         }
         return retS;
     }
     return "";
  } 
</script>
