cls_main.asp

采用的是新云内核

	'参  数：str ----搜索的字符串
	'返回值：True; False
	'================================================
	Public Function CheckQuery(ByVal str)
		Dim FobWords, i, keyword
		keyword = str
		On Error Resume Next
		FobWords = Array(91, 92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12532, 12533, 65339, 65340)
		For i = 1 To UBound(FobWords, 1)
			If InStr(keyword, ChrW(FobWords(i))) > 0 Then
				CheckQuery = False
				Exit Function
			End If
		Next
		FobWords = Array("~", "!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "+", "=", "`", "[", "]", "{", "}", ";", ":", """", "'", "<", ">", ".", "/", "\", "|", "?", "about", "after", "all", "also", "an", "and", "another", "any", "are", "as", "at", "be", "because", "been", "before", "being", "between", "both", "but", "by", "came", "can", "come", "could", "did", "do", "each", "for", "from", "get", "got", "had", "has", "have", "he", "her", "here", "him", "himself", "his", "how", "if", "in", "into", "is", "it", "like", "make", "many", "me", "might", "more", "most", "much", "must", "my", "never", "now", "of", "on", "only", "or", "other", "our", "out", "over", "said", "same", "see", "should", "since", "some", "still", "such", "take", "than", "that", "the", "their", "them", "then", "there", "these", "they", "this")
		keyword = Left(keyword, 100)
		keyword = Replace(keyword, "!", " ")
		keyword = Replace(keyword, "]", " ")
		keyword = Replace(keyword, "[", " ")
		keyword = Replace(keyword, ")", " ")
		keyword = Replace(keyword, "(", " ")
		keyword = Replace(keyword, "　", " ")
		keyword = Replace(keyword, "-", " ")
		keyword = Replace(keyword, "/", " ")
		keyword = Replace(keyword, "+", " ")
		keyword = Replace(keyword, "=", " ")
		keyword = Replace(keyword, ",", " ")
		keyword = Replace(keyword, "'", " ")
		For i = 0 To UBound(FobWords, 1)
			If keyword = FobWords(i) Then
				CheckQuery = False
				Exit Function
			End If
		Next
		CheckQuery = True
	End Function
	'================================================
	'函数名：IsValidStr
	'作  用：判断字符串中是否含有非法字符
	'参  数：str   ----原字符串
	'返回值：False,True -----布尔值
	'================================================
	Public Function IsValidStr(ByVal str)
		IsValidStr = False
		On Error Resume Next
		If IsNull(str) Then Exit Function
		If Trim(str) = Empty Then Exit Function
		Dim ForbidStr, i
		ForbidStr = "and|chr|:|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|^|" & Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
		ForbidStr = Split(ForbidStr, "|")
		For i = 0 To UBound(ForbidStr)
			If InStr(1,str, ForbidStr(i),1) > 0 Then
				IsValidStr = False
				Exit Function
			End If
		Next
		IsValidStr = True
	End Function
	'================================================
	'函数名：IsValidPassword
	'作  用：判断密码中是否含有非法字符
	'参  数：str   ----原字符串
	'返回值：False,True -----布尔值
	'================================================
	Public Function IsValidPassword(ByVal str)
		IsValidPassword = False
		On Error Resume Next
		If IsNull(str) Then Exit Function
		If Trim(str) = Empty Then Exit Function
		Dim ForbidStr, i
		ForbidStr = Chr(32) & "|" & Chr(34) & "|" & Chr(39) & "|" & Chr(9)
		ForbidStr = Split(ForbidStr, "|")
		For i = 0 To UBound(ForbidStr)
			If InStr(1, str, ForbidStr(i), 1) > 0 Then
				IsValidPassword = False
				Exit Function
			End If
		Next
		IsValidPassword = True
	End Function
	'================================================
	'函数名：IsValidChar
	'作  用：判断字符串中是否含有非法字符和中文
	'参  数：str   ----原字符串
	'返回值：False,True -----布尔值
	'================================================
	Public Function IsValidChar(ByVal str)
		IsValidChar = False
		On Error Resume Next
		
		If IsNull(str) Then Exit Function
		If Trim(str) = Empty Then Exit Function
		Dim ValidStr
		Dim i, l, s, c
		
		ValidStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~\/0123456789"
		l = Len(str)
		s = UCase(str)
		For i = 1 To l
			c = Mid(s, i, 1)
			If InStr(ValidStr, c) = 0 Then
				IsValidChar = False
				Exit Function
			End If
		Next
		IsValidChar = True
	End Function
	'================================================
	'函数名：FormatDate
	'作  用：格式化日期
	'参  数：DateAndTime   ----原日期和时间
	'        para   ----日期格式
	'返回值：格式化后的日期
	'================================================
	Public Function FormatDate(DateAndTime, para)
		On Error Resume Next
		Dim y, m, d, h, mi, s, strDateTime
		FormatDate = DateAndTime
		If Not IsNumeric(para) Then Exit Function
		If Not IsDate(DateAndTime) Then Exit Function
		y = CStr(Year(DateAndTime))
		m = CStr(Month(DateAndTime))
		If Len(m) = 1 Then m = "0" & m
		d = CStr(Day(DateAndTime))
		If Len(d) = 1 Then d = "0" & d
		h = CStr(Hour(DateAndTime))
		If Len(h) = 1 Then h = "0" & h
		mi = CStr(Minute(DateAndTime))
		If Len(mi) = 1 Then mi = "0" & mi
		s = CStr(Second(DateAndTime))
		If Len(s) = 1 Then s = "0" & s
		Select Case para
		Case "1":strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
		Case "2":strDateTime = y & "-" & m & "-" & d
		Case "3":strDateTime = y & "/" & m & "/" & d
		Case "4":strDateTime = y & "年" & m & "月" & d & "日"
		Case "5":strDateTime = m & "-" & d
		Case "6":strDateTime = m & "/" & d
		Case "7":strDateTime = m & "月" & d & "日"
		Case "8":strDateTime = y & "年" & m & "月"
		Case "9":strDateTime = y & "-" & m
		Case "10":strDateTime = y & "/" & m
		Case Else
			strDateTime = DateAndTime
		End Select
		FormatDate = strDateTime
	End Function
	'================================================
	'函数名：ReadFontMode
	'作  用：读取字体模式
	'参  数：str   ----原字符串
	'        vColor   -----颜色的值
	'        vFont   -----字体的值
	'返回值：新字符串
	'================================================
	Public Function ReadFontMode(str, vColor, vFont)
		Dim FontStr, tColor
		Dim ColorStr, arrColor
		
		If IsNull(str) Then
			ReadFontMode = ""
			Exit Function
		End If
		ReadFontMode = str
		On Error Resume Next
		If Not IsNumeric(vColor) Then Exit Function
		If Not IsNumeric(vFont) Then Exit Function
		
		Select Case CInt(vFont)
			Case 1
				FontStr = "<b>" & str & "</b>"
			Case 2
				FontStr = "<em>" & str & "</em>"
			Case 3
				FontStr = "<u>" & str & "</u>"
			Case 4
				FontStr = "<b><em>" & str & "</em></b>"
			Case 5
				FontStr = "<b><u>" & str & "</u></b>"
			Case 6
				FontStr = "<em><u>" & str & "</u></em>"
			Case 7
				FontStr = "<b><em><u>" & str & "</u></em></b>"
		Case Else
			FontStr = str
		End Select
		ReadFontMode = FontStr
		
		If vColor = "" Or vColor = 0 Then Exit Function
		ColorStr = "," & InitTitleColor
		arrColor = Split(ColorStr, ",")
		If vColor > UBound(arrColor) Then Exit Function
		tColor = Trim(arrColor(vColor))
		ReadFontMode = "<font color=" & tColor & ">" & FontStr & "</font>"
	End Function
	'=============================================================
	'函数名：ShowDateTime
	'作  用：读取日期格式
	'参  数：DateAndTime ---- 当前时间
	'        para ---- 时间格式
	'=============================================================
	Public Function ShowDateTime(DateAndTime, para)
		ShowDateTime = ""
		Dim strDate
		If Not IsDate(DateAndTime) Then Exit Function
		If DateAndTime >= Date Then
			strDate = "<font color='" & Main_Setting(1) & "'>"
			strDate = strDate & FormatDate(DateAndTime, para)
			strDate = strDate & "</font>"
		Else
			strDate = "<font color='" & Main_Setting(2) & "'>"
			strDate = strDate & FormatDate(DateAndTime, para)
			strDate = strDate & "</font>"
		End If
		ShowDateTime = strDate
	End Function
	Public Function ShowDatePath(strval, n)
		ShowDatePath = ""
		If Trim(strval) = "" Then Exit Function
		Dim strTempPath, strTime
		Dim y, m, d
		
		strTime = Left(strval, 8)
		y = Left(strTime, 4)
		m = Mid(strTime, 5, 2)
		d = Right(strTime, 2)
		Select Case CInt(n)
			Case 1
				strTempPath = y & "/" & m & "/" & d & "/"
			Case 2
				strTempPath = y & "/" & m & "/"
			Case 3
				strTempPath = y & m & "/"
			Case 4
				strTempPath = y & "/"
			Case 5
				strTempPath = y & "-" & m & "-" & d & "/"
			Case 6
				strTempPath = y & "-" & m & "/"
			Case 7
				strTempPath = "html/"
			Case 8
				strTempPath = "show/"
		Case Else
			strTempPath = ""
		End Select
		strTempPath = Replace(strTempPath, " ", "")
		ShowDatePath = CStr(strTempPath)
	End Function
	'=============================================================
	'函数名：ReadBriefTopicffd
	'作  用：读取简短标题
	'参  数：para
	'返回值：简短标题
	'=============================================================
	Public Function ReadBriefTopic(ByVal para)
		Dim sBriefTopic
		
		ReadBriefTopic = ""
		If Not IsNumeric(para) Then Exit Function
		If para = 0 Then Exit Function
		Select Case para
		Case "1"
			sBriefTopic = "<font color='blue'>[图文]</font>"
		Case "2"
			sBriefTopic = "<font color='red'>[组图]</font>"
		Case "3"
			sBriefTopic = "<font color='green'>[新闻]</font>"
		Case "4"
			sBriefTopic = "<font color='blue'>[推荐]</font>"
		Case "5"
			sBriefTopic = "<font color='red'>[注意]</font>"
		Case "6"
			sBriefTopic = "<font color='green'>[转载]</font>"
		Case Else
			sBriefTopic = ""
		End Select
		ReadBriefTopic = sBriefTopic
	End Function
	'=============================================================
	'函数名：ReadPicTopic
	'作  用：读取简短标题
	'参  数：para
	'返回值：简短标题
	'=============================================================
	Public Function ReadPicTopic(ByVal para)
		Dim sBriefTopic
		ReadPicTopic = ""
		If Not IsNumeric(para) Then Exit Function
		If para = 0 Then Exit Function
		Select Case para
		Case "1"
			sBriefTopic = "<font color='" & Main_Setting(4) & "'>[图文]</font>"
		Case "2"
			sBriefTopic = "<font color='" & Main_Setting(5) & "'>[组图]</font>"
		Case "3"
			sBriefTopic = "<font color='" & Main_Setting(6) & "'>[新闻]</font>"
		Case "4"
			sBriefTopic = "<font color='" & Main_Setting(4) & "'>[推荐]</font>"
		Case "5"
			sBriefTopic = "<font color='" & Main_Setting(5) & "'>[注意]</font>"
		Case "6"
			sBriefTopic = "<font color='" & Main_Setting(6) & "'>[转载]</font>"
		Case Else
			sBriefTopic = ""
		End Select
		ReadPicTopic = sBriefTopic
	End Function
	'=============================================================
	'函数名：ReadPayMoney
	'作  用：读取要支付的金钱
	'参  数：money   ----实际金钱
	'返回值：加上手续费后的金钱
	'=============================================================
	Public Function ReadPayMoney(ByVal money, ByVal Reduce)
		On Error Resume Next
		If money = 0 Then
			ReadPayMoney = 0
			Exit Function
		End If
		Dim arrChinaeBank, valPercent, Percents
		
		arrChinaeBank = Split(ChinaeBank, "|||")
		Percents = CCur(arrChinaeBank(2) / 100)
		
		If Percents = 0 Then
			ReadPayMoney = CCur(money)
		Else
			If CBool(Reduce) = True Then
				valPercent = Round(CCur(money) / (1 + 1 * Percents), 2)
				ReadPayMoney = CCur(valPercent)
			Else
				valPercent = Round(CCur(money) * Percents, 2)
				ReadPayMoney = CCur(money + valPercent)
			End If
		End If
	End Function
	'=============================================================
	'函数名：RebateMoney
	'作  用：读取打折的后金钱
	'参  数：money   ----实际金钱
	'        Discount   ----折扣
	'=============================================================
	Public Function RebateMoney(ByVal money, ByVal Discount)
		On Error Resume Next
		Dim Rebate
		
		money = CheckNumeric(money)
		Discount = CheckNumeric(Discount)
		If Discount > 0 And Discount < 10 Then
			Rebate = Round(money * (Discount / 10), 2)
			RebateMoney = CCur(Rebate)
		Else
			RebateMoney = CCur(money)
		End If