📄 powereasy.common.security.asp
字号:
'参 数：arrInvalidStr ----要查询的数组
' str1 ---- 要比较的字符
'返回值：True ----是否存在
'**************************************************
Function CheckValidStr(arrInvalidStr, str1)
Dim arrStr, i
If InStr(arrInvalidStr, ",") > 0 Then
arrStr = Split(arrInvalidStr, ",")
For i = 0 To UBound(arrStr)
If LCase(Trim(arrStr(i))) = LCase(Trim(str1)) Then
CheckValidStr = False
Exit Function
End If
Next
Else
If LCase(Trim(arrInvalidStr)) = LCase(Trim(str1)) Then
CheckValidStr = False
Exit Function
End If
End If
CheckValidStr = True
End Function
'**************************************************
'函数名：IsValidID
'作 用：检查传过来的ＩＤ是否是合法ＩＤ或者ＩＤ串
'参 数：Check_ID ---- ID 字符串
'返回值：True ---- 合法ID
'**************************************************
Function IsValidID(Check_ID)
Dim FixID, i
If IsNull(Check_ID) Or Check_ID = "" Then
IsValidID = False
Exit Function
End If
FixID = Replace(Check_ID, "|", "")
FixID = Replace(FixID, ",", "")
FixID = Replace(FixID, "-", "")
FixID = Trim(Replace(FixID, " ", ""))
If FixID = "" Or IsNull(FixID) Then
IsValidID = False
Else
For i = 1 To Len(FixID) Step 100
If Not IsNumeric(Mid(FixID, i, 100)) Then
IsValidID = False
Exit Function
End If
Next
IsValidID = True
End If
End Function
'**************************************************
'函数名：PE_ConvertBR
'作 用：将文本区域内的<BR>替换换行
'参 数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
Function PE_ConvertBR(ByVal fString)
If IsNull(fString) Or Trim(fString) = "" Then
PE_ConvertBR = ""
Exit Function
End If
fString = Replace(fString, "</P><P>", Chr(10) & Chr(10))
fString = Replace(fString, "<BR>", Chr(10))
fString = Replace(fString, "<br>", Chr(10))
PE_ConvertBR = fString
End Function
'**************************************************
'函数名：PE_HTMLEncode
'作 用：将html 标记替换成 能在IE显示的HTML
'参 数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
Function PE_HTMLEncode(ByVal fString)
If IsNull(fString) Or Trim(fString) = "" Then
PE_HTMLEncode = ""
Exit Function
End If
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><P>")
fString = Replace(fString, Chr(10), "<BR>")
PE_HTMLEncode = fString
End Function
'**************************************************
'函数名：PE_HtmlDecode
'作 用：还原Html标记,配合PE_HTMLEncode 使用
'参 数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
Function PE_HtmlDecode(ByVal fString)
If IsNull(fString) Or Trim(fString) = "" Then
PE_HtmlDecode = ""
Exit Function
End If
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, " ", " ")
fString = Replace(fString, """, Chr(34))
fString = Replace(fString, "'", Chr(39))
fString = Replace(fString, "</P><P> ", Chr(10) & Chr(10))
fString = Replace(fString, "<BR> ", Chr(10))
PE_HtmlDecode = fString
End Function
'**************************************************
'函数名：nohtml
'作 用：过滤html 元素
'参 数：str ---- 要过滤字符
'返回值：没有html 的字符
'**************************************************
Function nohtml(ByVal str)
If IsNull(str) Or Trim(str) = "" Then
nohtml = ""
Exit Function
End If
regEx.Pattern = "(\<.[^\<]*\>)"
str = regEx.Replace(str, "")
regEx.Pattern = "(\<\/[^\<]*\>)"
str = regEx.Replace(str, "")
regEx.Pattern = "\[NextPage(.*?)\]" '解决“当在文章模块的频道中发布的是图片并使用分页标签[NextPage]或内容开始的前几行就使用分页标签时，一旦使用搜索来搜索该文时，搜索页就会显示分页标签”的问题
str = regEx.Replace(str, "")
str = Replace(str, "'", "")
str = Replace(str, Chr(34), "")
str = Replace(str, vbCrLf, "")
str = Trim(str)
nohtml = str
End Function
'**************************************************
'函数名：xml_nohtml
'作 用：过滤xml 和 html 元素
'参 数：str ---- 要过滤字符
'返回值：没有 xml 和 html 的字符串
'**************************************************
Function xml_nohtml(ByVal fString)
If IsNull(fString) Or Trim(fString) = "" Then
xml_nohtml = ""
Exit Function
End If
Dim str, k
str = Replace(fString, ">", ">")
str = Replace(str, "<", "<")
str = Replace(str, " ", "")
str = Replace(str, """, "")
str = Replace(str, "'", "")
str = nohtml(str)
str = Replace(Replace(str, "<![CDATA[", ""), "]]>", "")
xml_nohtml = str
End Function
'**************************************************
'函数名：unicode
'作 用：转换为 UTF8 编码
'参 数：str ---- 要转换的字符
'返回值：转换后的字符
'**************************************************
Function unicode(ByVal str)
Dim i, j, c, i1, i2, u, fs, f, p
unicode = ""
p = ""
For i = 1 To Len(str)
c = Mid(str, i, 1)
j = AscW(c)
If j < 0 Then
j = j + 65536
End If
If j >= 0 And j <= 128 Then
If p = "c" Then
unicode = " " & unicode
p = "e"
End If
unicode = unicode & c
Else
If p = "e" Then
unicode = unicode & " "
p = "c"
End If
unicode = unicode & ("&#" & j & ";")
End If
Next
End Function
'**************************************************
'函数名：Jencode
'作 用：替换那26个片假名字符(效率很差目前没有用到)
'参 数：str ---- 要替换的字符
' DatabaseType ---- 数据库类型
'返回值：替换后的字符
'**************************************************
Function Jencode(ByVal iStr, DatabaseType)
If IsNull(iStr) Or IsEmpty(iStr) Or iStr = "" Or DatabaseType = "SQL" Then
Jencode = ""
Exit Function
End If
Dim E, f, i
E = Array("Jn0;", "Jn1;", "Jn2;", "Jn3;", "Jn4;", "Jn5;", "Jn6;", "Jn7;", "Jn8;", "Jn9;", "Jn10;", "Jn11;", "Jn12;", "Jn13;", "Jn14;", "Jn15;", "Jn16;", "Jn17;", "Jn18;", "Jn19;", "Jn20;", "Jn21;", "Jn22;", "Jn23;", "Jn24;", "Jn25;")
f = Array(Chr(-23116), Chr(-23124), Chr(-23122), Chr(-23120), Chr(-23118), Chr(-23114), Chr(-23112), Chr(-23110), Chr(-23099), Chr(-23097), Chr(-23095), Chr(-23075), Chr(-23079), Chr(-23081), Chr(-23085), Chr(-23087), Chr(-23052), Chr(-23076), Chr(-23078), Chr(-23082), Chr(-23084), Chr(-23088), Chr(-23102), Chr(-23104), Chr(-23106), Chr(-23108))
Jencode = iStr
For i = 0 To 25
Jencode = Replace(Jencode, f(i), E(i))
Next
End Function
Function Juncode(ByVal iStr, DatabaseType)
If IsNull(iStr) Or IsEmpty(iStr) Or iStr = "" Or DatabaseType = "SQL" Then
Juncode = ""
Exit Function
End If
Dim E, f, i
E = Array("Jn0;", "Jn1;", "Jn2;", "Jn3;", "Jn4;", "Jn5;", "Jn6;", "Jn7;", "Jn8;", "Jn9;", "Jn10;", "Jn11;", "Jn12;", "Jn13;", "Jn14;", "Jn15;", "Jn16;", "Jn17;", "Jn18;", "Jn19;", "Jn20;", "Jn21;", "Jn22;", "Jn23;", "Jn24;", "Jn25;")
f = Array(Chr(-23116), Chr(-23124), Chr(-23122), Chr(-23120), Chr(-23118), Chr(-23114), Chr(-23112), Chr(-23110), Chr(-23099), Chr(-23097), Chr(-23095), Chr(-23075), Chr(-23079), Chr(-23081), Chr(-23085), Chr(-23087), Chr(-23052), Chr(-23076), Chr(-23078), Chr(-23082), Chr(-23084), Chr(-23088), Chr(-23102), Chr(-23104), Chr(-23106), Chr(-23108))
Juncode = iStr
For i = 0 To 25
Juncode = Replace(Juncode, E(i), f(i))
Next
End Function
Function IsValidPhone(Phone)
Dim i, c
IsValidPhone = True
For i = 1 To Len(Phone)
c = LCase(Mid(Phone, i, 1))
If InStr("-()", c) <= 0 And Not IsNumeric(c) Then
IsValidPhone = False
Exit Function
End If
Next
End Function
'**************************************************
'函数名：DelRightComma
'作 用：删除字符串（如："1,3,5,8"）右侧多余的逗号以消除SQL查询时出错的问题，Comma：逗号。
'参 数：str ---- 待处理的字符串
'**************************************************
Function DelRightComma(ByVal str)
str = Trim(str)
If Right(str, 1) = "," Then
str = Left(str, Len(str) - 1)
End If
DelRightComma = str
End Function
'**************************************************
'函数名：FilterArrNull
'作 用：过滤数组空字符
'**************************************************
Function FilterArrNull(ByVal ArrString, ByVal CompartString)
Dim arrContent, arrTemp, i
If CompartString = "" Or ArrString = "" Then
FilterArrNull = ArrString
Exit Function
End If
If InStr(ArrString, CompartString) = 0 Then
FilterArrNull = ArrString
Exit Function
Else
arrContent = Split(ArrString, CompartString)
For i = 0 To UBound(arrContent)
If Trim(arrContent(i)) <> "" Then
If arrTemp = "" Then
arrTemp = Trim(arrContent(i))
Else
arrTemp = arrTemp & CompartString & Trim(arrContent(i))
End If
End If
Next
End If
FilterArrNull = arrTemp
End Function
'=================================================
'函数名：FilterJS()
'作 用：过滤非法JS字符
'参 数：strInput 需要过滤的内容
'=================================================
Function FilterJS(ByVal strInput)
If IsNull(strInput) Or Trim(strInput) = "" Then
FilterJS = ""
Exit Function
End If
Dim reContent
' 替换掉HTML字符实体(Character Entities)名字和分号之间的空白字符，比如：ä ;替换成ä
regEx.Pattern = "(&#*\w+)[\x00-\x20]+;"
strInput = regEx.Replace(strInput, "$1;")
' 将无分号结束符的数字编码实体规范成带分号的标准形式
regEx.Pattern = "(&#x*[0-9A-F]+);*"
strInput = regEx.Replace(strInput, "$1;")
' 将 < > & "字符实体中的 & 替换成 & 以便在进行HtmlDecode时保留这些字符实体
'RegEx.Pattern = "&(amp|lt|gt|nbsp|quot);"
'strInput = RegEx.Replace(strInput, "&$1;")
' 将HTML字符实体进行解码，以消除编码字符对后续过滤的影响
'strInput = HtmlDecode(strInput);
' 将ASCII码表中前32个字符中的非打印字符替换成空字符串，保留 9、10、13、32，它们分别代表 制表符、换行符、回车符和空格。
regEx.Pattern = "[\x00-\x08\x0b-\x0c\x0e-\x19]"
strInput = regEx.Replace(strInput, "")
oldhtmlString = ""
Do While oldhtmlString <> strInput
oldhtmlString = strInput
regEx.Pattern = "(<[^>]+src[\x00-\x20]*=[\x00-\x20]*[^>]*?)&#([^>]*>)" '过虑掉 src 里的 &#
strInput = regEx.Replace(strInput, "$1&#$2")
regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)&#([^>]*>)" '过虑掉style 里的 &#
strInput = regEx.Replace(strInput, "$1&#$2")
regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)\\([^>]*>)" '替换掉style中的 "\"
strInput = regEx.Replace(strInput, "$1/$2")
Loop
' 替换以on和xmlns开头的属性，动易系统的几个JS需要保留
regEx.Pattern = "on(load\s*=\s*""*'*resizepic\(this\)'*""*)"
strInput = regEx.Replace(strInput, "off$1")
regEx.Pattern = "on(mousewheel\s*=\s*""*'*return\s*bbimg\(this\)'*""*)"
strInput = regEx.Replace(strInput, "off$1")
regEx.Pattern = "(<[^>]+[\x00-\x20""'/])(on|xmlns)([^>]*)>"
strInput = regEx.Replace(strInput, "$1pe$3>")
regEx.Pattern = "off(load\s*=\s*""*'*resizepic\(this\)'*""*)"
strInput = regEx.Replace(strInput, "on$1")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -