<%
'---------------HTML代码过滤-----------
function HTMLEncode(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), "</P><br/><p>")
fString = Replace(fString, CHR(10), "<p>")
fString = Replace(fString, CHR(36), "$")
HTMLEncode = fString
End IF
end function
'----------------SQL过滤---------------
function filter(text)
if isnull(text) then
filter=""
exit function
End IF
filter=replace(text,"'","''")
end function
'---------------------------------------
Function ubb2html(content)
On Error Resume Next
content=trim(content)
content=HTMLEncode(content)
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 = 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, "[center]", "<center>", 1, -1, 1)
ubb = Replace(ubb, "[/center]", "</center>", 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)
ubb2html = ubb
End Function
'================================================================================Ubb代码解析函数Convert
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, "<img src="&codetext, 1, 1, 1)
cText = Replace(cText, "[/img]", " >", 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, "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.,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.' 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.,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.' type='application/x-shockwave-flash' width='500' height='500'>" & "[/swf]", "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.,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.' type='application/x-shockwave-flash' width='500' height='500'>" & "</embed></object>", 1, 1, 1)
End Select
Loop
Convert = cText
End Function
%>
[
本帖最后由 enjoy535 于 2011-8-31 21:32 编辑 ]