UBB问题 - ASP技术论坛

得分:0

回复：（caiyakang）UBB问题

<%
Class UbbCode
Private Function unHtml(content)
On Error Resume Next
unHtml = content
If content <> "" Then
unHtml = Replace(unHtml, "&", "&")
unHtml = Replace(unHtml, "<", "<")
unHtml = Replace(unHtml, ">", ">")
'unHtml= Replace(unHtml,chr(34),""")
unHtml = Replace(unHtml, Chr(13), "<br>")
unHtml = Replace(unHtml, Chr(32), " ")
'unHtml=ubb(unHtml)
End If
End Function
'Ubb代码主函数
Public Function ubb(content)
On Error Resume Next
Dim nowtime, i
ubb = content
nowtime = Now()
ubb = Convert(ubb, "code")
ubb = Convert(ubb, "html")
ubb = Convert(ubb, "url")
ubb = Convert(ubb, "color")
ubb = Convert(ubb, "font")
ubb = Convert(ubb, "size")
ubb = Convert(ubb, "quote")
ubb = Convert(ubb, "email")
ubb = Convert(ubb, "img")
ubb = Convert(ubb, "swf")
'ubb = AutoURL(ubb)
ubb = Replace(ubb, "", "<b>", 1, -1, 1)
ubb = Replace(ubb, "", "</b>", 1, -1, 1)
ubb = Replace(ubb, "", "<i>", 1, -1, 1)
ubb = Replace(ubb, "", "</i>", 1, -1, 1)
ubb = Replace(ubb, "", "<u>", 1, -1, 1)
ubb = Replace(ubb, "", "</u>", 1, -1, 1)
ubb = Replace(ubb, "[blue]", "<font color='#000099'>", 1, -1, 1)
ubb = Replace(ubb, "[/blue]", "</font>", 1, -1, 1)
ubb = Replace(ubb, "[red]", "<font color='#990000'>", 1, -1, 1)
ubb = Replace(ubb, "[/red]", "</font>", 1, -1, 1)
For i = 1 To 28
ubb = Replace(ubb, "{:em" & i & "}", "<IMG SRC=emot/emotface/em" & i & ".gif></img>", 1, 6, 1)
ubb = Replace(ubb, "{:em" & i & "}", "", 1, -1, 1)
Next
ubb = Replace(ubb, "[" & Chr(176), "[", 1, -1, 1)
ubb = Replace(ubb, Chr(176) & "]", "]", 1, -1, 1)
ubb = Replace(ubb, "/" & Chr(176), "/", 1, -1, 1)
' ubb=Replace(ubb,"{;em","{:em",1,-1,1)
End Function
'Ubb代码解析函数
Private Function Convert(ubb, CovT)
On Error Resume Next
Dim cText, startubb, endubb, Lcovt, text, codetext
cText = ubb
startubb = 1
Do While CovT = "url" Or CovT = "color" Or CovT = "font" Or CovT = "size"
startubb = InStr(startubb, cText, "[" & CovT & "=", 1)
If startubb = 0 Then
Exit Do
End If
endubb = InStr(startubb, cText, "]", 1)
If endubb = 0 Then
Exit Do
End If
Lcovt = CovT
startubb = startubb + Len(Lcovt) + 2
text = Mid(cText, startubb, endubb - startubb)
codetext = Replace(text, "[", "[" & Chr(176), 1, -1, 1)
codetext = Replace(codetext, "]", Chr(176) & "]", 1, -1, 1)
'codetext=Replace(codetext,"{:em","{;em",1,-1,1)
codetext = Replace(codetext, "/", "/" & Chr(176), 1, -1, 1)
Select Case CovT
Case "color"
cText = Replace(cText, "[color=" & text & "]", "<font color='" & text & "'>", 1, 1, 1)
cText = Replace(cText, "[/color]", "</font>", 1, 1, 1)
Case "font"
cText = Replace(cText, "", "<font face='" & text & "'>", 1, 1, 1)
cText = Replace(cText, "", "</font>", 1, 1, 1)
Case "size"
If IsNumeric(text) Then
If text > 6 Then
text = 6
End If
If text < 1 Then
text = 1
End If
cText = Replace(cText, "[size=" & text & "]", "<font size='" & text & "'>", 1, 1, 1)
cText = Replace(cText, "[/size]", "</font>", 1, 1, 1)
End If
Case "url"
cText = Replace(cText, "[url=" & text & "]", "<a href='" & codetext & "' target=_blank>", 1, 1, 1)
cText = Replace(cText, "[/url]", "</a>", 1, 1, 1)
Case "email"
cText = Replace(cText, "[" & CovT & "=" & text & "]", "<a href=mailto:" & text & ">", 1, 1, 1)
cText = Replace(cText, "[/" & CovT & "]", "</a>", 1, 1, 1)
End Select
Loop
startubb = 1
Do
startubb = InStr(startubb, cText, "[" & CovT & "]", 1)
If startubb = 0 Then
Exit Do
End If
endubb = InStr(startubb, cText, "[/" & CovT & "]", 1)
If endubb = 0 Then
Exit Do
End If
Lcovt = CovT
startubb = startubb + Len(Lcovt) + 2
text = Mid(cText, startubb, endubb - startubb)
codetext = Replace(text, "[", "[" & Chr(176), 1, -1, 1)
codetext = Replace(codetext, "]", Chr(176) & "]", 1, -1, 1)
'codetext=Replace(codetext,"{:em","{;em",1,-1,1)
codetext = Replace(codetext, "/", "/" & Chr(176), 1, -1, 1)
Select Case CovT
Case "url"
cText = Replace(cText, "[" & CovT & "]" & text, "<a href='" & codetext & "' target=_blank>" & codetext, 1, 1, 1)
cText = Replace(cText, "<a href='" & codetext & "' target=_blank>" & codetext & "[/" & CovT & "]", "<a href=" & codetext & " target=_blank>" & codetext & "</a>", 1, 1, 1)
Case "email"
cText = Replace(cText, "[" & CovT & "]", "<a href=mailto:" & text & ">", 1, 1, 1)
cText = Replace(cText, "[/" & CovT & "]", "</a>", 1, 1, 1)
Case "html"
codetext = Replace(codetext, "<br>", Chr(13), 1, -1, 1)
codetext = Replace(codetext, " ", Chr(32), 1, -1, 1)
Randomize
rid = "temp" & Int(100000 * Rnd)
cText = Replace(cText, "[html]" & text, "代码片断如下：<TEXTAREA id=" & rid & " rows=15 style='width:100%' class='bk'>" & codetext, 1, 1, 1)
cText = Replace(cText, "代码片断如下：<TEXTAREA id=" & rid & " rows=15 style='width:100%' class='bk'>" & codetext & "[/html]", "代码片断如下：<TEXTAREA id=" & rid & " rows=15 style='width:100%' class='bk'>" & codetext & "</TEXTAREA><INPUT onclick=runEx('" & rid & "') type=button value=运行此段代码 name=Button1 class='Tips_bo'> <INPUT onclick=JM_cc('" & rid & "') type=button value=复制到我的剪贴板 name=Button2 class='Tips_bo'>", 1, 1, 1)
Case "img"
cText = Replace(cText, "[img]" & text, "<a href=" & Chr(34) & "about:<img src=" & codetext & " border=0>" & Chr(34) & " target=_blank><img src=" & codetext, 1, 1, 1)
cText = Replace(cText, "[/img]", " vspace=2 hspace=2 border=0 alt=::点击图片在新窗口中打开::></a>", 1, 1, 1)
Case "code"
cText = Replace(cText, "

\" & text, \"以下内容为程序代码<hr noshade>\" & codetext, 1, 1, 1)
              cText = Replace(cText, \"以下内容为程序代码<hr noshade>\" & codetext & \"

", "以下内容为程序代码<hr noshade>" & codetext & "<hr noshade>", 1, 1, 1)
Case "quote"
atext = Replace(text, "[img]", "", 1, -1, 1)
atext = Replace(atext, "[/img]", "", 1, -1, 1)
atext = Replace(atext, "[swf]", "", 1, -1, 1)
atext = Replace(atext, "[/swf]", "", 1, -1, 1)
atext = Replace(atext, "[html]", "", 1, -1, 1)
atext = Replace(atext, "[/html]", "", 1, -1, 1)
' atext=Replace(atext,"{:em","{;em",1,-1,1)
atext = Split(atext, 350)
atext = Replace(atext, Chr(32), " ", 1, -1, 1)
cText = Replace(cText, "

" & text, "<blockquote><hr noshade>" & atext, 1, 1, 1)
cText = Replace(cText, "<blockquote><hr noshade>" & atext & "

", "<blockquote><hr noshade>" & atext & "<hr noshade></blockquote>", 1, 1, 1)
Case "swf"
cText = Replace(cText, "[swf]" & text, "影片地址:<br>" & text & "<br><object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='500' height='500'><param name=movie value='" & codetext & "'><param name=quality value=high><embed src='" & codetext & "' quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='500' height='500'>", 1, 1, 1)
cText = Replace(cText, "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='500' height='500'><param name=movie value='" & codetext & "'><param name=quality value=high><embed src='" & codetext & "' quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='500' height='500'>" & "[/swf]", "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='500' height='500'><param name=movie value='" & codetext & "'><param name=quality value=high><embed src='" & codetext & "' quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='500' height='500'>" & "</embed></object>", 1, 1, 1)
End Select
Loop
Convert = cText
End Function
End Class
%>
从网上找的，本人一直用这个。用法
Dim oUbb
Set oUbb=New UbbCode
Response.Write oUbb.ubb("[url=http://bbs.bc-cn.net]编程中国[/url]")