?? ubbcode.asp
字號:
<%
'**************************************************
'函數名：UBB_Code
'作 用：UBB代碼轉換
'參 數：str ----需轉換的字符
'返回值：轉換后的字符
'**************************************************
Function UBB_Code(Str)
If Str="" Or IsNull(Str) Then Exit Function
Dim s,re,r
set re = New RegExp
re.Global = True
re.IgnoreCase = True
s = str
If InStr(s,"payto:") = 0 Then
s = Replace(s,"https://www.alipay.com/payt","https://www.alipay.com/payto:")
End If
s=TM_Alipay_PayTo(s)
re.Pattern="\[code\](.*?)\[\/code\]"
s=re.Replace(s,"<b>CODE:</b><div class=""code"">"&Server.HtmlEncode("$1")&"</div>")
'RM-UBB
re.Pattern="\[RM=*([0-9]*),*([0-9]*),*([true|false]*)\](.[^\[]*)\[\/RM]"
s=re.Replace(s,"<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>")
'MP-UBB
re.Pattern="\[MP=*([0-9]*),*([0-9]*),*([true|false]*)\](.[^\[]*)\[\/MP]"
s=re.Replace(s,"<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>")
'FLASH
re.Pattern="(\[FLASH=*([0-9]*),*([0-9]*)\])(http://|ftp://|../)(.[^\[]*)(\[\/FLASH\])"
If team.Forum_setting(69) = 1 Then
s= re.Replace(s,"<a href=""$4$5"" TARGET=""_blank""><IMG SRC=""images/type/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=""$2"" height=""$3""><PARAM NAME=""movie"" VALUE=""$4$5""><PARAM NAME=""quality"" VALUE=""high""><embed src=""$4$5"" quality=""high"" pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""$2"" height=""$3"">$4$5</embed></OBJECT>")
Else
s= re.Replace(s,"<a href=""$4$5"" TARGET=""_blank""><IMG SRC=""images/type/swf.gif"" border=""0"" align=""bsmiddle"" height=""16"" width=""16"">[全屏欣賞,注意Flash可能含有不安全內容]</a>")
End If
If Not Request("newpage")="edit" Then
s = b2html(s)
re.Pattern="\[UPLOAD=(gif|jpg|jpeg|bmp|png)\](.*?)\[\/UPLOAD]"
If team.Forum_setting(69) = 1 Then
s=re.Replace(s,"<BR><A HREF=""$2"" TARGET=_blank><IMG SRC=""$2"" border=0 alt=""按此在新窗口瀏覽圖片"" onmouseover=""javascript:if(this.width>520)this.width=520;"" style=""CURSOR: hand"" onload=""javascript:if(this.width>520)this.width=520;""'></A>")
Else
s=re.Replace(s,"<BR><A HREF=""$2"" TARGET=_blank><IMG SRC=""images/type/$1.gif"" border=0 alt=""按此在新窗口瀏覽圖片""></A>")
End If
If team.Forum_setting(69) = 1 Then
re.Pattern="\[img\]\s*([^\[\<\r\n]+?)\s*\[\/img\]"
s=re.Replace(s,"<img src=""$1"" border=""0"" onload=""if(this.width>screen.width*0.7) {this.resized=true; this.width=screen.width*0.7; this.alt='Click here to open new window\\nCTRL+Mouse wheel to zoom in/out';}"" onmouseover=""if(this.width>screen.width*0.7) {this.resized=true; this.width=screen.width*0.7; this.style.cursor='hand'; this.alt='Click here to open new window\\nCTRL+Mouse wheel to zoom in/out';}"" onclick=""if(!this.resized) {return true;} else {window.open('$1');}"" onmousewheel=""return imgzoom(this);"" alt="""" />")
re.Pattern="\[img=(\d{1,3})[x|\,](\d{1,3})\]\s*([^\[\<\r\n]+?)\s*\[\/img\]"
s=re.Replace(s,"<img width=""$1"" height=""$2"" src=""$3"" border=""0"" alt="""" />")
Else
re.Pattern="\[img\]\s*([^\[\<\r\n]+?)\s*\[\/img\]"
s=re.Replace(s,"<a href=""$1"" target=""_blank"">$1</a>")
re.Pattern="\[img=(\d{1,3})[x|\,](\d{1,3})\]\s*([^\[\<\r\n]+?)\s*\[\/img\]"
s=re.Replace(s,"<a href=""$1"" target=""_blank"">$1</a>")
End If
re.Pattern="\[UPLOAD=(txt|rar|zip)\]([0-9]*)\[\/UPLOAD]"
If team.Group_Browse(24) = 0 Then
s=re.Replace(s,"<img src=""images/type/$1.gif"" border=""0"" align=""absmiddle""> 您所在的組沒有查看附件的權限。")
Else
s=re.Replace(s,"<img src=""images/type/$1.gif"" border=""0"" align=""absmiddle""><A HREF=""ShowFile.asp?ID=$2"" TARGET=""_blank"">點擊瀏覽該文件</A>")
End If
re.Pattern="\[UPLOAD=(swf|swi)\](.*?)\[\/UPLOAD]"
If team.Forum_setting(14) = 1 Then
s=re.Replace(s,"<img src=""images/type/$1.gif"" border=""0"" align=""absmiddle""><br><embed src=""$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,"<img src=""images/type/$1.gif"" border=""0"" align=""absmiddle""><A HREF=""$2"" TARGET=""_blank"">[全屏欣賞,注意Flash可能含有不安全內容]</A>")
End if
re.Pattern="\[UPLOAD=(.[^\[]*)\]([0-9]*)\[\/UPLOAD]"
s=re.Replace(s,"<img src=""images/type/$1.gif"" border=""0"" align=""absmiddle""><A HREF=""ShowFile.asp?ID=$2"" TARGET=""_blank"">點擊瀏覽該文件</A>")
If Instr(s,"[REPLAYVIEW]")>0 or Instr(s,"[replayview]")>0 Then
Dim Uid,CodeRs
UID=int(Request.QueryString("tid"))
Set CodeRs = team.Execute("Select UserName,Relist,Replies From Forum Where ID="& UID )
IF Not CodeRs.Eof And Request.QueryString("retopicid")="" Then
re.Pattern="\[REPLAYVIEW\][\s\n]*\[\/REPLAYVIEW\]"
s=re.Replace(s,"")
re.Pattern="\[\/REPLAYVIEW\]"
s=re.replace(s, chr(1)&"/REPLAYVIEW]")
re.Pattern="\[REPLAYVIEW\]([^\x01]*)\x01\/REPLAYVIEW\]"
If Not team.UserLoginED Then
s=re.Replace(s,"<fieldset class=textquote><legend><strong>回復可見貼</strong></legend>本帖內容已被隱藏,請登陸后查看!</fieldset>")
Else
If tk_UserName = CodeRs(0) or team.ManageUser Or Team.Execute("Select Count(ID) From "&CodeRs(1)&" Where Topicid="&UID&" And UserName='"&TK_UserName&"'")(0)>0 Then
s=re.Replace(s,"<fieldset class=textquote><legend><strong>回復可見貼</strong></legend>$1</fieldset>")
Else
s=re.Replace(s,"<fieldset class=textquote><legend><strong>回復可見貼</strong></legend>本帖內容已被隱藏,回復本帖后才可查看!</fieldset>")
End If
End if
End If
End If
End if
UBB_Code=ChkBadWords(s)
Set re = Nothing
End Function
'簽名用UBB
Function Sign_Code(Str,a)
If Str="" Or IsNull(Str) Then Exit Function
Dim s,re
s = Str
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
s=Replace(s,"<BR>","<br>")
s=Replace(s,"</P><P>","</p><p>")
s=Replace(s,"<","<")
s=Replace(s," "," ")
If Int(a) = 0 Then
Sign_Code = s
Exit Function
End if
re.Pattern="\[marquee\](.*?)\[\/marquee]"
s=re.Replace(s,"<marquee width=90% behavior=alternate scrollamount=""3"">$1</marquee>")
re.Pattern="\[font=([^<>\]]*?)\](.*?)\[\/font]"
s=re.Replace(s,"<font face=""$1"">$2</font>")
re.Pattern="\[color=([^<>\]]*?)\](.*?)\[\/color]"
s=re.Replace(s,"<font color=""$1"">$2</font>")
re.Pattern="\[align=([^<>\]]*?)\](.*?)\[\/align]"
s=re.Replace(s,"<div align=""$1"">$2</div>")
re.Pattern="\[size=(\d*?)\](.*?)\[\/size]"
s=re.Replace(s,"<font size=""$1"">$2</font>")
re.Pattern="\[b\](.*?)\[\/b]"
s=re.Replace(s,"<strong>$1</strong>")
re.Pattern="\[p\](.*?)\[\/p]"
s=re.Replace(s,"<p>$1</p>")
re.Pattern="\[strike\](.*?)\[\/strike]"
s=re.Replace(s,"<strike>$1</strike>")
re.Pattern="\[li\](.*?)\[\/li]"
s=re.Replace(s,"<li>$1</li>")
re.Pattern="\[s\](.*?)\[\/s]"
s=re.Replace(s,"<s>$1</s>")
re.Pattern="\[i\](.*?)\[\/i]"
s=re.Replace(s,"<em>$1</em>")
re.Pattern="\[u\](.*?)\[\/u]"
s=re.Replace(s,"<u>$1</u>")
re.Pattern="\[p\](.*?)\[\/p]"
s=re.Replace(s,"<p>$1</p>")
re.Pattern="\[sub\](.*?)\[\/sub]"
s=re.Replace(s,"<sub>$1</sub>")
re.Pattern="\[sup\](.*?)\[\/sup]"
s=re.Replace(s,"<sup>$1</sup>")
re.Pattern="\[glow\](.*?)\[\/glow]"
s=re.Replace(s,"<span style='behavior:url(inc/font.htc)'>$1</span>")
re.Pattern="\[qq\](\d*?)\[\/qq]"
s=re.Replace(s,"<a target=blank href=http://wpa.qq.com/msgrd?V=1&Uin=$1&Site=team5.cn&Menu=yes><img border=""0"" SRC=http://wpa.qq.com/pa?p=1:$1:5 alt=""點擊這里給我發消息""></a>")
re.Pattern="\[URL\](.*?)\[\/URL]"
s=re.Replace(s,"<A HREF=""$2"" TARGET=_blank>$2</A>")
re.Pattern="(\[URL=(.[^\[]*)\])(.*?)(\[\/URL\])"
s= re.Replace(s,"<A HREF=""$2"" TARGET=_blank>$3</A>")
re.Pattern="\[IMG\](.*?)\[\/IMG]"
s=re.Replace(s,"<IMG SRC=""$1"" border=0>")
re.Pattern="\[QUOTE\](.*?)\[\/QUOTE]"
s=re.Replace(s,"<div class=""quote"">$1</div>")
Sign_Code=ChkBadWords(s)
Set re = Nothing
End Function
Private Function TM_Alipay_PayTo(strText)
If Not Isnull(strText) Then
Dim s,ss,re
Dim match,match2,urlStr,re2
Dim t(2),temp,check,fee,i,encode8_tmp
s=strText
Set re=new RegExp
re.IgnoreCase =true
re.Global=true
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="API/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&"<div class=code><br/><b>商品名稱</b>："&temp&"<br/><br/>"
urlStr = urlStr & "&subject=" & Server.UrlEncode(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=" & Server.UrlEncode(Cutstr(temp,200))
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\)"
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -