📄 inc_functions.asp
字号:
<%
'#############################################################
'# 中国在线--极酷论坛 ver.2001 3.0
'#
'# 版权所有: 中国在线 (ChinaXP.Net)
'#
'# 制作人 : 周周 (SeeYa!)
'#
'#
'# 主页地址: http://www.ChinaXP.net/ 中国在线
'# http://www.ChinaXP.Net/bbs/ 中国在线--极酷论坛
'#
'#############################################################
Function OnlineSQLencode(byVal strPass)
If not isNull(strPass) and strPass <> "" Then
strPass = Replace(strPass, "%", "'%'")
strPass = Replace(strPass, "'", "''")
strPass = Replace(strPass, "|", "'|'")
OnlineSQLencode = strPass
End If
End Function
Function OnlineSQLdecode(byVal strPass)
If not isNull(strPass) and strPass <> "" Then
strPass = Replace(strPass, "'%'", "%")
strPass = Replace(strPass, "''", "'")
strPass = Replace(strPass, "'|'", "|")
OnlineSQLdecode = strPass
End If
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),6)) <> "HREF=""") and (UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(right(strArray(counter-1),6)) <> "[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),5)) <> "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 ChkMail(fString, fTestTag, fType)
Dim strArray
Dim Counter
Dim strTempString
strTempString = fString
if Instr(1, fString, fTestTag) > 0 then
strArray = Split(fString, fTestTag, -1)
strTempString = ""
' strTempString = strArray(0)
for counter = 0 to UBound(strArray)
if (Instr(strArray(counter), "@") > 0) and not(Instr(strArray(counter), "mailto:") > 0) and not(Instr(UCase(strArray(counter)), "[URL") > 0) then
strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType)
else
strTempString = strTempString & fTestTag & strArray(counter)
end if
next
end if
ChkMail = strTempString
end function
function doublenum(fNum)
if fNum > 9 then
doublenum = fNum
else
doublenum = "0" & fNum
end if
end function
function widenum(fNum)
if fNum > 9 then
widenum = " "
else
widenum = " "
end if
end function
function Chked(fYN)
if fYN = "yes" or fYN = "1" or fYN = 1 then '**
Chked = " Checked"
else
Chked = ""
end if
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
strTextAreaStart = "代码片断如下：<TEXTAREA name=textfield style=""width:100%"" rows=15>"
strTextAreaEnd = "</TEXTAREA><INPUT name=Button1 onclick=runEx() type=button value=""运行此代码""> <INPUT name=Button2 onclick=copy() type=button value=""复制此代码"">"
function ClearSpace(fString)
' 清除空格字符 " " 转换成 " "
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, " ", " ")
fString = Replace(fString, " ", " ")
ClearSpace = fString
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>")
if strBadWordFilter = 1 then
fString = ChkBadWords(fString)
end if
if strAllowFLASH = "1" then
fString = FormatFlash(fString)
end if
if InStr(fString,"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000")=0 then
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)
end if
'fString = edit_hrefs(fString, 5)
fString = ReplaceUrls(fString)
FormatStr = fString
end function
function FormatStr2(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>")
if strBadWordFilter = 1 then
fString = ChkBadWords(fString)
end if
if strAllowFLASH = "1" then
fString = FormatFlash(fString)
end if
if InStr(fString,"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000")=0 then
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)
end if
'fString = edit_hrefs(fString, 5)
fString = ReplaceUrls(fString)
FormatStr2 = fString
end function
' ### 新 FLASH 处理程序 ###
function FormatFlash(fString)
on Error resume next
fString = Replace(fString, "[FLASH]", "[flash]")
fString = Replace(fString, "[/FLASH]", "[/flash]")
strTempString = fString
strFlashBASE = "<OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 width=500 height=400 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><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=400>$2</embed></OBJECT>"
strLen1 = Instr(strTempString, "[flash]")
strLen2 = Instr(strTempString, "[/flash]")
if strLen1 > 0 and strLen2 > 0 then
' ### 区分Flash是不是在第一行 ###
if strLen1 = 1 then
strFlashTemp = Mid(strTempString, strLen1, strLen2+Len("[/flash]")-1)
strFlashUrl = Replace(Replace(strFlashTemp, "[flash]", ""), "[/flash]", "")
else
strFlashTemp = Mid(strTempString, strLen1, strLen2 - strLen1 + Len("[/flash]"))
strFlashUrl = Replace(Replace(strFlashTemp, "[flash]", ""), "[/flash]", "")
end if
' ### 将 Flash 文件的 URL 压入代码
strFlashBASE = Replace(strFlashBASE, "$2", strFlashUrl)
strTempString = Replace(strTempString, strFlashTemp, strFlashBASE, 1, -1, 1)
set strFlashUrl = Nothing
set strFlashBASE = Nothing
end if
FormatFlash = strTempString
end function
'######################################################
'### CleanQouteCode ###
'######################################################
'###### Append By Guozi On 2001-09-28 16:14 #######
'######################################################
function CleanQuoteCode(fString)
Dim tmpString
'### Check And Remove New Quote Code ###
if fString = "" then
tmpString = " "
else
QuoteHead = "<BR><table cellpadding=0 cellspacing=0 border=0 WIDTH=94% bgcolor=#000000 align=center>"
QuoteTail = "</td></tr></table></td></tr></table>" & VbCrLf
QuoteTail2 = "</td></tr></table></td></tr></table>"
LenStr = Len(fString)
QuoteStart = InStr(fString, QuoteHead)
if QuoteStart > 0 then
if InStr(fString, QuoteTail) = 0 then
QuoteEnd = InStr(fString, QuoteTail2) + Len(QuoteTail2)
else
QuoteEnd = InStr(fString, QuoteTail) + Len(QuoteTail)
end if
if LenStr >= QuoteEnd then
tmpString = Left(fString, QuoteStart - 1 ) + Mid(fString, QuoteEnd, LenStr - QuoteEnd + 1)
else
tmpString = Left(fString, QuoteStart - 1 )
end if
else
tmpString = fString
end if
end if
'### Check And Remove Old Quote Code ###
fString = tmpString
if fString = "" then
tmpString = " "
else
QuoteHead = "<BLOCKQUOTE id=quote><font size=" & strFooterFontSize & " face=""" & strDefaultFontFace & """ id=quote>"
QuoteTail = "<hr height=1 noshade id=quote></font id=quote></BLOCKQUOTE id=quote>" & VbCrLf
LenStr = Len(fString)
QuoteStart = InStr(fString, QuoteHead)
if QuoteStart > 0 then
QuoteEnd = InStr(fString, QuoteTail) + Len(QuoteTail)
if LenStr >= QuoteEnd then
tmpString = Left(fString, QuoteStart - 1 ) + Mid(fString, QuoteEnd, LenStr - QuoteEnd + 1)
else
tmpString = Left(fString, QuoteStart - 1 )
end if
else
tmpString = fString
end if
end if
CleanQuoteCode = tmpString
end function
function CleanCode(fString)
if fString = "" then
fString = " "
else
if strAllowForumCode = "1" then
fString = replace(fString, "<b>","[b]", 1, -1, 1)
fString = replace(fString, "</b>","[/b]", 1, -1, 1)
fString = replace(fString, "<s>", "[s]", 1, -1, 1)
fString = replace(fString, "</s>", "[/s]", 1, -1, 1)
fString = replace(fString, "<u>","[u]", 1, -1, 1)
fString = replace(fString, "</u>","[/u]", 1, -1, 1)
fString = replace(fString, "<i>","[i]", 1, -1, 1)
fString = replace(fString, "</i>","[/i]", 1, -1, 1)
fString = replace(fString, "<font face='Andale Mono'>", "[font=Andale Mono]", 1, -1, 1)
fString = replace(fString, "</font id='Andale Mono'>", "[/font=Andale Mono]", 1, -1, 1)
fString = replace(fString, "<font face='Arial'>", "[font=Arial]", 1, -1, 1)
fString = replace(fString, "</font id='Arial'>", "[/font=Arial]", 1, -1, 1)
fString = replace(fString, "<font face='Arial Black'>", "[font=Arial Black]", 1, -1, 1)
fString = replace(fString, "</font id='Arial Black'>", "[/font=Arial Black]", 1, -1, 1)
fString = replace(fString, "<font face='Book Antiqua'>", "[font=Book Antiqua]", 1, -1, 1)
fString = replace(fString, "</font id='Book Antiqua'>", "[/font=Book Antiqua]", 1, -1, 1)
fString = replace(fString, "<font face='Century Gothic'>", "[font=Century Gothic]", 1, -1, 1)
fString = replace(fString, "</font id='Century Gothic'>", "[/font=Century Gothic]", 1, -1, 1)
fString = replace(fString, "<font face='Comic Sans MS'>", "[font=Comic Sans MS]", 1, -1, 1)
fString = replace(fString, "</font id='Comic Sans MS'>", "[/font=Comic Sans MS]", 1, -1, 1)
fString = replace(fString, "<font face='Courier New'>", "[font=Courier New]", 1, -1, 1)
fString = replace(fString, "</font id='Courier New'>", "[/font=Courier New]", 1, -1, 1)
fString = replace(fString, "<font face='Georgia'>", "[font=Georgia]", 1, -1, 1)
fString = replace(fString, "</font id='Georgia'>", "[/font=Georgia]", 1, -1, 1)
fString = replace(fString, "<font face='Impact'>", "[font=Impact]", 1, -1, 1)
fString = replace(fString, "</font id='Impact'>", "[/font=Impact]", 1, -1, 1)
fString = replace(fString, "<font face='Tahoma'>", "[font=Tahoma]", 1, -1, 1)
fString = replace(fString, "</font id='Tahoma'>", "[/font=Tahoma]", 1, -1, 1)
fString = replace(fString, "<font face='Times New Roman'>", "[font=Times New Roman]", 1, -1, 1)
fString = replace(fString, "</font id='Times New Roman'>", "[/font=Times New Roman]", 1, -1, 1)
fString = replace(fString, "<font face='Trebuchet MS'>", "[font=Trebuchet MS]", 1, -1, 1)
fString = replace(fString, "</font id='Trebuchet MS'>", "[/font=Trebuchet MS]", 1, -1, 1)
fString = replace(fString, "<font face='Script MT Bold'>", "[font=Script MT Bold]", 1, -1, 1)
fString = replace(fString, "</font id='Script MT Bold'>", "[/font=Script MT Bold]", 1, -1, 1)
fString = replace(fString, "<font face='Stencil'>", "[font=Stencil]", 1, -1, 1)
fString = replace(fString, "</font id='Stencil'>", "[/font=Stencil]", 1, -1, 1)
fString = replace(fString, "<font face='宋体'>", "[font=宋体]", 1, -1, 1)
fString = replace(fString, "</font id='宋体'>", "[/font=宋体]", 1, -1, 1)
fString = replace(fString, "<font face='Lucida Console'>", "[font=Lucida Console]", 1, -1, 1)
fString = replace(fString, "</font id='Lucida Console'>", "[/font=Lucida Console]", 1, -1, 1)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -