📄 inc_code.asp
字号:
<%
'┌─ 风云ASP在线 ────────────────────────┐
'│ │
'│ 作者：赵振波. http://www.fyasp.com │
'│ │
'│ Q Q：185623333 │
'│ │
'│ Email：fy96@163.com │
'│ │
'│ 程序定做，系统开发，网站制作，提供高质量的网络产品、技术和服务！│
'│ │
'│【版权声明】 │
'│ │
'│ 本程序版权归坐看风云所有，未经授权擅自修改、复制或散布本程序│
'│ │
'│的部分或全部，将承受严厉的民事和刑事处罚，对已知的违反者将给予法 │
'│ │
'│律范围内的全面制裁。对非法使用此程序所造成的一切后果本人概不负责!│
'│ │
'└─────────────────── http://www.fyasp.com ──┘
%>
<%
'/非HTML代码转换函数/
Function Html2Txt(vString)
vString = replace(vString, ">", ">")
vString = replace(vString, "<", "<")
vString = Replace(vString, CHR(32) & CHR(32) & CHR(32) & CHR(32), " ")
vString = Replace(vString, CHR(10) & CHR(10), "<br>")
vString = Replace(vString, CHR(10), "<BR>")
Html2Txt = vString
End Function
'/UBB代码转换函数/
'/--------------Start UBB Code--------------------------/
function UbbMl(fString)
UbbMl = ChkString(FormatStr(ReplaceColor(ReplaceFlash(HTMLEncode(fString)))))
end function
function doCode(fString, fOTag, fCTag, fROTag, fRCTag)
fOTagPos = Instr(1, fString, fOTag, 1)
fCTagPos = Instr(1, fString, fCTag, 1)
while (fCTagPos > 0 and fOTagPos > 0)
fString = replace(fString, fOTag, fROTag, 1, 1, 1)
fString = replace(fString, fCTag, fRCTag, 1, 1, 1)
fOTagPos = Instr(1, fString, fOTag, 1)
fCTagPos = Instr(1, fString, fCTag, 1)
wend
doCode = fString
end function
function HTMLEncode(fString)
fString = Replace(fString, CHR(32) & CHR(32) & CHR(32) & CHR(32), " ")
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
HTMLEncode = fString
end function
function ChkString(fString)
fString = doCode(fString, "[b]", "[/b]", "<b>", "</b>")
fString = doCode(fString, "[s]", "[/s]", "<s>", "</s>")
fString = doCode(fString, "[strike]", "[/strike]", "<s>", "</s>")
fString = doCode(fString, "[u]", "[/u]", "<u>", "</u>")
fString = doCode(fString, "[i]", "[/i]", "<i>", "</i>")
fString = doCode(fString, "[font=宋体]", "[/font=宋体]", "<font face=宋体>", "</font id=宋体>")
fString = doCode(fString, "[font=楷体_GB2312]", "[/font=楷体_GB2312]", "<font face=楷体_GB2312>", "</font id=楷体_GB2312>")
fString = doCode(fString, "[font=新宋体]", "[/font=新宋体]", "<font face=新宋体>", "</font id=新宋体>")
fString = doCode(fString, "[font=黑体]", "[/font=黑体]", "<font face=黑体>", "</font id=黑体>")
fString = doCode(fString, "[font=隶书]", "[/font=隶书]", "<font face=隶书>", "</font id=隶书>")
fString = doCode(fString, "[font=Arial]", "[/font=Arial]", "<font face=Arial>", "</font id=Arial>")
fString = doCode(fString, "[h1]", "[/h1]", "<h1>", "</h1>")
fString = doCode(fString, "[h2]", "[/h2]", "<h2>", "</h2>")
fString = doCode(fString, "[h3]", "[/h3]", "<h3>", "</h3>")
fString = doCode(fString, "[h4]", "[/h4]", "<h4>", "</h4>")
fString = doCode(fString, "[h5]", "[/h5]", "<h5>", "</h5>")
fString = doCode(fString, "[h6]", "[/h6]", "<h6>", "</h6>")
fString = doCode(fString, "[size=1]", "[/size=1]", "<font size=1>", "</font id=size1>")
fString = doCode(fString, "[size=2]", "[/size=2]", "<font size=2>", "</font id=size2>")
fString = doCode(fString, "[size=3]", "[/size=3]", "<font size=3>", "</font id=size3>")
fString = doCode(fString, "[size=4]", "[/size=4]", "<font size=4>", "</font id=size4>")
fString = doCode(fString, "[size=5]", "[/size=5]", "<font size=5>", "</font id=size5>")
fString = doCode(fString, "[size=6]", "[/size=6]", "<font size=6>", "</font id=size6>")
fString = doCode(fString, "[list]", "[/list]", "<ul>", "</ul>")
fString = doCode(fString, "[list=1]", "[/list=1]", "<ol type=1>", "</ol id=1>")
fString = doCode(fString, "[list=a]", "[/list=a]", "<ol type=a>", "</ol id=a>")
fString = doCode(fString, "[*]", "[/*]", "<li>", "</li>")
fString = doCode(fString, "[align=left]", "[/align]", "<div align=left>", "</div id=left>")
fString = doCode(fString, "[align=center]", "[/align]", "<center>", "</center>")
fString = doCode(fString, "[align=right]", "[/align]", "<div align=right>", "</div id=right>")
fString = doCode(fString, "[code]", "[/code]", "<pre id=code><font face=courier size=" & strDefaultFontSize & " id=code>", "</font id=code></pre id=code>")
fString = doCode(fString, "[quote]", "[/quote]", "<BLOCKQUOTE id=quote>引用：<hr size=1 noshade id=quote>", "<hr size=1 noshade id=quote></BLOCKQUOTE id=quote>")
fString = replace(fString, "[br]", "<br>", 1, -1, 1)
fString = doCode(fString, "[img]","[/img]","<img src=""",""" border=0>")
fString = doCode(fString, "[image]","[/image]","<img src=""",""" border=0>")
fString = doCode(fString, "[img=right]","[/img=right]","<img align=right src=""",""" id=right border=0>")
fString = doCode(fString, "[image=right]","[/image=right]","<img align=right src=""",""" id=right border=0>")
fString = doCode(fString, "[img=left]","[/img=left]","<img align=left src=""",""" id=left border=0>")
fString = doCode(fString, "[image=left]","[/image=left]","<img align=left src=""",""" id=left border=0>")
ChkString = fString
end function
function ChkUrls(fString, fTestTag, fType)
Dim strArray
Dim Counter
Dim strTempString
strTempString = fString
if Instr(1, fString, fTestTag) > 0 then
strArray = Split(fString, fTestTag, -1)
strTempString = strArray(0)
for counter = 1 to UBound(strArray)
if ((strArray(counter-1) = "" or len(strArray(counter-1)) < 5) and strArray(counter)<> "") then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
elseif ((UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(right(strArray(counter-1),11)) <> "[URL=""") and (UCase(right(strArray(counter-1),7)) <> "FILE:///") and (UCase(right(strArray(counter-1),7)) <> "HTTP://") and (UCase(right(strArray(counter-1),8)) <> "HTTPS://") and (UCase(right(strArray(counter-1),5)) <> "SRC=""") and (UCase(right(strArray(counter-1),10)) <> "SRC=""") and strArray(counter)<> "") then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
else
strTempString = strTempString & fTestTag & strArray(counter)
end if
next
end if
ChkUrls = strTempString
end function
function FormatStr(fString)
on Error resume next
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
fString = Replace(fString, CHR(10), "<BR>")
fString = ChkUrls(fString,"http://", 1)
fString = ChkUrls(fString,"https://", 2)
fString = ChkUrls(fString,"file:///", 3)
fString = ChkUrls(fString,"www.", 4)
fString = ChkUrls(fString,"mailto:",5)
fString = ChkMail(fString," ",5)
fString = ReplaceUrls(fString)
FormatStr = fString
end function
Function ReplaceUrls(fString)
Dim oTag, c1Tag, c2Tag
Dim roTag, rc1Tag, rc2Tag
Dim oTagPos, c1TagPos, c2TagPos
Dim nTagPos
Dim counter2
Dim strArray, strArray2, strArray3
oTag = "[url="""
oTag2 = "[url]"
roTag = "<a href="""
c1Tag = """]"
c1Tag2 = "[/url]"
rc1Tag = """ target=""_New"">"
c2Tag = "[/url]"
rc2Tag = "</a>"
oTagPos = InStr(1, fString, oTag, 1)
c1TagPos = InStr(1, fString, c1Tag, 1)
strTempString = ""
if (oTagpos > 0) and (c1TagPos > 0) then
strArray = Split(fString, oTag, -1)
for counter2 = 0 to UBound(strArray)
if (InStr(1, strArray(counter2), c2Tag, 1) > 0) and (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
strArray2 = Split(strArray(counter2), c1Tag, -1)
if Instr(1, strArray2(1), c2Tag) then
strFirstPart = Left(strArray2(1), Instr(1, strArray2(1),c2Tag)-1)
strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1, strArray2(1), c2Tag) - len(c2Tag)+1))
if strFirstPart <> "" then
strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
else
strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart
end if
else
strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
end if
elseif (InStr(1, strArray(counter2), c1Tag, 1) > 0) then
strArray2 = Split(strArray(counter2), c1Tag, -1)
strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
else
strTempString = strTempString & strArray(counter2)
end if
next
else
strTempString = fString
end if
oTagPos2 = InStr(1, strTempString, oTag2, 1)
c1TagPos2 = InStr(1, strTempString, c1Tag2, 1)
if (oTagpos2 > 0) and (c1TagPos2 > 0) then
strTempString2 = ""
strArray = Split(strTempString, oTag2, -1)
for counter3 = 0 to Ubound(strArray)
if (Instr(1, strArray(counter3), c1Tag2) > 0) then
strArray2 = split(strArray(counter3), c1Tag2, -1)
strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
else
strTempString2 = strTempString2 & strArray(counter3)
end if
next
strTempString = strTempString2
end if
ReplaceUrls = strTempString
End Function
Function ReplaceColor(fString)
dim strHead,strLast,vHead,vLast,strTag
dim vHeadString,vTempString,vLastString
strHead = "[color="
strLast = "[/color]"
vHead = "<font color="
vLast = "</font>"
do while Instr(1,fString,strHead) > 0
strTag = Instr(1,fString,strHead)
vHeadString = left(fString,strTag - 1)
vTempString = right(fString,len(fString) - strTag)
vTempString = right(vTempString,len(vTempString) - (Instr(1,vTempString,"=")))
vLastString = right(vTempString,len(vTempString) - (instr(1,vTempString,"]")))
vTempString = left(vTempString,InStr(1,vTempString,"]") - 1)
vTempString = vHead & vTempString &">"
fString = vHeadString & vTempString & vLastString
loop
ReplaceColor = Replace(fString,"[/color]", vLast)
End Function
Function ReplaceFlash(fString)
dim strHeadString,sqlLastString,strSecondString,strFlashPath
do while Instr(fString,"[flash]") <> 0 And Instr(fString,"[/flash]") <> 0
strHeadString = left(fString,Instr(fString,"[flash]") - 1)
strLastString = right(fString,len(fString) - (Instr(fString,"[/flash]") + 7))
strFlashPath = Right(fString,len(fString) - (Instr(fString,"[flash]") + 6))
strFlashPath = Left(strFlashPath,Instr(strFlashPath,"[/flash]") - 1)
fString = strHeadString &"<OBJECT classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://active.macromedia.com/flash2/cabs/swflash.cab#version=4,0,0,0"" WIDTH=""550"" HEIGHT=""400"">" &_
"<PARAM NAME=""movie"" VALUE="""& strFlashPath &""">" &_
"<PARAM NAME=""quality"" VALUE=""high"">" &_
"<EMBED src="""& strFlashPath &""" loop=""false"" menu=""false"" quality=""high"" WIDTH=""550"" HEIGHT=""400"" TYPE=""application/x-shockwave-flash"" PLUGINSPAGE=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"">" &_
"</EMBED>" &_
"</OBJECT>" & strLastString
loop
ReplaceFlash = fString
End Function
'/----------------------End of UBB Code----------------------------------/
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -