📄 inc_functions.asp

📁 电子备课系统
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<%
'此处为非Bool型判断，也可以用于基本的Bool型判定
'如果目标值为空或者Null,则指定一个默认值,不指定则默认为空
Function ob_IIF(byval var1,byval dValue)
	Dim sReturn
	If IsNull(var1) Or IsEmpty(var1) Then
		sReturn=""
	Else
		sReturn=Trim(var1)
	End If
	If sReturn="" Then sReturn=dValue
	ob_IIF=sReturn
End Function

'此处用于布尔型判断，如果为真，则设置为A，否则设置为B
'如果目标值为空或者为Null，则默认为false
Function ob_IIF2(byval var1,byval dValue1,byval dValue2)
	Dim bValue,sReturn
	If IsNull(var1) Or var1="" Then
		bValue=false
	Else
		If var1="0" or var1=false Then
			bValue=false
		Else
			bValue=true
		End If
	End If
	If bValue Then
		sReturn=dValue1
	Else
		sReturn=dValue2
	End If
	ob_IIF2=sReturn
End Function

'根据纪录集过滤获得指定值
Function GetRsValue(byval rst1,field1,field2,value1,type1)
	rst1.Filter=""
	If rst1.Eof Then Exit Function
	rst1.Movefirst
	If rst1.Eof Then
		GetRsValue=""
	Else
		'数值型
		If type1="0" Or type1="" Then
			rst1.Filter=field1 & "=" & value1
		'字符型
		Else
			rst1.Filter=field1 & "='" & value1 & "'"
		End If
		If Not rst1.Eof Then
			GetRsValue=rst1(field2)
		Else
			GetRsValue=""
		End If
	End if
End Function

'调试模式
Sub OB_Debug(str,iend)
	Response.Write "<br />---------------------------------调试信息开始---------------------------------<br/>"
	If IsNull(str) Then
		Response.Write "值为Null"
	ElseIf IsEmpty(str) Then
		Response.Write "值为Empty"
	ElseIf IsArray(str) Then
		Response.Write "值为Array"
	Else
		If str="" Then
			Response.Write "系统提示：执行到这里来了"
		Else
			Response.Write str
		End if
	End If
	Response.Write "<p>调试时间:" & Now & "</p>"
	Response.Write "<br/>---------------------------------调试信息结束---------------------------------<br/>"
	If iend="1" Then Response.End
End Sub

Sub ReturnClientMsg(byval divid,byval msg)
	Dim sReturn
	sReturn= "<script language=javascript>if(chkdiv("""& divid &""")==true) { document.getElementById(""" & divid &""").innerHTML="""& msg &""";}</script>"
End Sub

Function unHtml(content)
    On Error Resume Next
    unHtml = content
    If content <> "" Then
        unHtml = Server.HTMLEncode(unHtml)
        unHtml = Replace(unHtml, vbCrLf, "<br>")
        unHtml = Replace(unHtml, Chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
        unHtml = Replace(unHtml, " ", "&nbsp;")
        unHtml = Replace(unHtml, "&", "")
        unHtml = Replace(unHtml, "?", "")
    End If
End Function

'x<60     -Minutes
'60<=x<1440 -Hours
'x>=24 -Days
'Response.Write FmtMinutes("2006-4-30 12:21")
Function FmtMinutes(sTime)
	Dim i,j,sReturn,iMinutes
	If IsNull(sTime) Or sTime="" Then
		FmtMinutes="-"
		Exit Function
	End If
	iMinutes=Datediff("n",sTime,Now)
	If iMinutes<60 Then
		FmtMinutes=iMinutes & "分钟"
		Exit Function
	End If
	i=iMinutes Mod 60
	j=iMinutes \ 60
	If j<24 Then
		FmtMinutes=j & "小时"' & i & "&nbsp;分钟"
	Else
		'Re do
		i = i Mod 24
		j = j \ 24
		FmtMinutes=j & "天"' & i & "&nbsp;小时"
	End If
End Function

'------------------------------------------------
'EncodeJP(byval strContent)
'日文编码
'10k文章编码过程小于0.01秒，不会影响到执行效率
'目前需要更新的位置为：
'站点配置里的各个项目：名称、描述
'发布文章时的标题、内容、关键字
'发布留言/评论时的内容
'搜索时对关键字进行编码
'暂时不考虑注册名问题
'可与其他函数配合使用
'------------------------------------------------
Function EncodeJP(byval strContent)

	If strContent="" Then Exit Function

	'SQL版本不进行编码
	If IS_SQLDATA=1 Then
		EncodeJP=strContent
		Exit Function
	End If

	strContent=Replace(strContent,"ガ","&#12460;")
    strContent=Replace(strContent,"ギ","&#12462;")
    strContent=Replace(strContent,"グ","&#12464;")
    strContent=Replace(strContent,"ア","&#12450;")
    strContent=Replace(strContent,"ゲ","&#12466;")
    strContent=Replace(strContent,"ゴ","&#12468;")
    strContent=Replace(strContent,"ザ","&#12470;")
    strContent=Replace(strContent,"ジ","&#12472;")
    strContent=Replace(strContent,"ズ","&#12474;")
    strContent=Replace(strContent,"ゼ","&#12476;")
    strContent=Replace(strContent,"ゾ","&#12478;")
    strContent=Replace(strContent,"ダ","&#12480;")
    strContent=Replace(strContent,"ヂ","&#12482;")
    strContent=Replace(strContent,"ヅ","&#12485;")
    strContent=Replace(strContent,"デ","&#12487;")
    strContent=Replace(strContent,"ド","&#12489;")
    strContent=Replace(strContent,"バ","&#12496;")
    strContent=Replace(strContent,"パ","&#12497;")
    strContent=Replace(strContent,"ビ","&#12499;")
    strContent=Replace(strContent,"ピ","&#12500;")
    strContent=Replace(strContent,"ブ","&#12502;")
    strContent=Replace(strContent,"ブ","&#12502;")
    strContent=Replace(strContent,"プ","&#12503;")
    strContent=Replace(strContent,"ベ","&#12505;")
    strContent=Replace(strContent,"ペ","&#12506;")
    strContent=Replace(strContent,"ボ","&#12508;")
    strContent=Replace(strContent,"ポ","&#12509;")
    strContent=Replace(strContent,"ヴ","&#12532;")

    EncodeJP=strContent
End Function

'------------------------------------------------
'FilterJS(strHTML)
'过滤脚本
'------------------------------------------------
Function FilterJS(byval strHTML)
	Dim objReg,strContent
	If IsNull(strHTML) OR strHTML="" Then Exit Function
	Set objReg=New RegExp
	objReg.IgnoreCase =True
	objReg.Global=True
	objReg.Pattern="(&#)"
	strContent=objReg.Replace(strHTML,"")
	objReg.Pattern="(function|meta|value|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie)"
	strContent=objReg.Replace(strContent,"")
	objReg.Pattern="(on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"
	strContent=objReg.Replace(strContent,"")
	FilterJS=strContent
	strContent=""
	Set objReg=Nothing
End Function

'------------------------------------------------
'CheckInt(byval strNumber)
'检查并转换整形值
'------------------------------------------------
Function CheckInt(byval strNumber)
	If isNull(strNumber) OR Not IsNumeric(strNumber) Then
		strNumber=0
	End If
	CheckInt=Int(strNumber)
End Function

'------------------------------------------------
'ProtectSql(sSql)
'用于接收地址栏参数传递时SQL组合保护
'------------------------------------------------
'防止SQL注入
Function ProtectSQL(sSql)
	If ISNull(sSql) Then Exit Function
	sSql=Trim(sSql)
	If sSql="" Then Exit Function
	sSql=Replace(sSql,Chr(0),"")
	sSql=Replace(sSql,"'","‘")
	sSql=Replace(sSql," ","")
	sSql=Replace(sSql,"%","％")
	sSql=Replace(sSql,"-","－")
	ProtectSQL=sSql
End Function

'用于用户发布的各种信息过滤，带脏话过滤
Function HTMLEncode(fString)
	If Not IsNull(fString) Then
		fString = Replace(fString, ">", "&gt;")
		fString = Replace(fString, "<", "&lt;")
		fString = Replace(fString, CHR(32), " ")		'&nbsp;
		fString = Replace(fString, CHR(9), " ")			'&nbsp;
		fString = Replace(fString, CHR(34), "&quot;")
		'fString = Replace(fString, CHR(39), "&#39;")	'单引号过滤
		fString = Replace(fString, CHR(13), "")
		fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
		fString = Replace(fString, CHR(10), "<BR> ")
		'fString=ChkBadWords(fString)
		HTMLEncode = fString
	End If
End Function

'------------------------------------------------
'RemoveHtml(byval strContent)
'移除HTML标记
'主要用户保存到数据库前的过滤
'------------------------------------------------
Function RemoveHtml(byval strContent)
	Dim objReg ,strTmp
	If strContent="" OR ISNull(strContent) Then Exit Function
	Set objReg=new RegExp
	objReg.IgnoreCase =True
	objReg.Global=True
	objReg.Pattern="<(.[^>]*)>"
	strTmp=objReg.replace(strContent, "")
	Set objReg=Nothing
	RemoveHtml=strTmp
	strTmp=""
End Function
'------------------------------------------------
'RemoveUBB(byval strContent)
'移除UBB标记
'主要用户保存到数据库前的过滤
'------------------------------------------------
Function RemoveUBB(byval strContent)
	Dim objReg ,strTmp
	If strContent="" OR ISNull(strContent) Then Exit Function
	Set objReg=new RegExp
	objReg.IgnoreCase =True
	objReg.Global=True
	objReg.Pattern="[.+?]"
	strTmp=objReg.replace(strContent, "")
	Set objReg=Nothing
	RemoveUBB=strTmp
	strTmp=""
End Function
'------------------------------------------------
'RedirectBy301(strURL)
'针对搜索引擎进行301重定向，立即更新目标地址
'------------------------------------------------
Sub RedirectBy301(ByVal strURL)
	Response.Clear
	Response.Status="301 Moved Permanently"
	Response.AddHeader "Location",strURL
	Response.End
End Sub

'获取访问者IP
'Response.Write GetIP
Function GetIP()
	Dim sIP
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
		sIP = Request.ServerVariables("REMOTE_ADDR")
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
		sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
		sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
	Else
		sIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	End If
	If sIP = "" Then sIP = "0.0.0.0"
	GetIP = CheckIP(sIP)
End Function

Function CheckIP(sIP)
	sIP=Trim(sIP)
	sIP=Replace(sIP,".",",")
	sIP=ChkIDs(sIP)
	If sIP<>"" Then sIP=Replace(sIP,",",".")
	CheckIP=sIP
End Function

Function ChkIDs(byval sIDs)
	Dim aIDs,i,sReturn
	sIDs=Trim(sIDs)
	If Len(sIDs)=0  Then Exit Function
	aIDs=Split(sIDs,",")
	For i=0 To Ubound(aIDs)
		'发现任意不符合的字符，直接跳出
		If Not IsNumeric(aIDs(i)) Then
			Exit Function
		Else
			sReturn=sReturn & "," & Int(aIDs(i))
		End If
	Next
	If Left(sReturn,1)="," Then sReturn=Right(sReturn,Len(sReturn)-1)
	ChkIDs=sReturn
	sReturn=""
End Function

Function FilterIDs(byval strIDs)
	Dim arrIDs,i,strReturn
	strIDs=Trim(strIDs)
	If Len(strIDs)=0  Then Exit Function
	arrIDs=Split(strIDs,",")
	For i=0 To Ubound(arrIds)
		If IsNumeric(arrIDs(i)) Then
			strReturn=strReturn & "," & Int(arrIDs(i))
		End If
	Next
	If Left(strReturn,1)="," Then strReturn=Right(strReturn,Len(strReturn)-1)
	FilterIDs=strReturn
End Function

Function FilterStrings(byval strIDs)
	Dim arrIDs,i,strReturn
	strIDs=Trim(strIDs)
	If Len(strIDs)=0  Then Exit Function
	arrIDs=Split(strIDs,",")
	For i=0 To Ubound(arrIds)
		If arrIDs(i)<>"" Then
			strReturn=strReturn & "," & arrIDs(i)
		End If
	Next
	If Left(strReturn,1)="," Then strReturn=Right(strReturn,Len(strReturn)-1)
	FilterStrings=strReturn
End Function

Function RndPassword(myLength)
	Const minLength = 6
	Const maxLength = 12
	Randomize
	Dim X, Y, strPW

	If myLength = 0 Then
		Randomize
		myLength = Int((maxLength * Rnd) + minLength)
	End If


	For X = 1 To myLength
		Y = Int((3 * Rnd) + 1) '(1) Numeric, (2) Uppercase, (3) Lowercase

		select Case Y
			Case 1
				'Numeric character
				Randomize
				strPW = strPW & CHR(Int((9 * Rnd) + 48))
			Case 2
				'Uppercase character
				Randomize
				strPW = strPW & CHR(Int((25 * Rnd) + 65))
			Case 3
				'Lowercase character
				Randomize
				strPW = strPW & CHR(Int((25 * Rnd) + 97))
		End select
	Next
	RndPassword = strPW '& Int(rnd*timer)

End Function
12 下一页
💿 文件大小 12553 K
👤 上传用户 tiger452
📂 所属分类教育系统应用
🏷️ 相关标签

#电子
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -