⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 inc_functions.asp

📁 实现一个用JSP、Servlet技术实现的小型物流网站系统。实现功能如下：管理员通过登录该系统
💻 ASP
📖 第 1 页 / 共 2 页
字号:
🔍
12 
<%
'*********************************************************
'File: 			Inc_Functions.asp
'Description:	公用函数模块 For oBlog4.0
'Author: 		阿泰 
'Copyright:		http://www.oblog.cn
'LastUpdate:	20060405
'*********************************************************
'此处为非Bool型判断，也可以用于基本的Bool型判定
'如果目标值为空或者Null,则指定一个默认值,不指定则默认为空
Function ob_IIF(byval var1,byval dValue)
	Dim sReturn
	If IsNull(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/>"
	If IsNull(str) Then
		Response.Write "值为Null"
	Else
		If str="" Then
			Response.Write "系统提示：执行到这里来了"
		Else
			Response.Write str
		End if
	End If
	Response.Write "<p>调试时间:" & Now & "</p>"
	Response.Write "<br/>---------------------------------调试信息结束---------------------------------"
	If iend="1" Then Response.End	
End Sub

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


Function ob_Int(sInt)
	If IsNull(sInt) Or IsEmpty(sInt) Or Len(sInt)=0 Or Not IsNumeric(sInt) Then 
		ob_Int=""
		Exit Function 
	End If
	'Not support with dot.
	If InStr(sInt,".")>0 Then 
		ob_Int=""
		Exit Function
	End If
	ob_Int=Int(sInt)
End Function

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
	'iMinutes=Datediff("n",sTime,ServerTime(Now))
	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

'------------------------------------------------
'Pause(byval iCount)
'暂停功能
'用于批量转移，转换，生成过程中，防止持续耗费系统资源
'------------------------------------------------
Sub Pause()
	Dim i,lStep,iCount
	iCount=P_BLOG_UPDATEPAUSE
	'本机测试执行时间为0.03~0.05
	lStep=200000	
	'如果为0或者非数值则不限制
	If  Not IsNumeric(iCount) OR iCount=0 Then Exit Sub
	iCount=Int(iCount)
	'Response.Write timer & "<br>"
	'本机测试3~5秒
	If iCount>100 Then iCount=100
	For i=1 To iCount * lStep
	Next
	'Response.Write timer 
End Sub

'------------------------------------------------
'CheckValidEnName(byval strName)
'只允许数字(48~57)+大(65~90)小(97~122)写字母和下划线
'------------------------------------------------
Function CheckValidEnName(byval strName)
	Dim objReg,i,c
	CheckValidEnName = True	
	If IsNull(strName) OR strName="" Then Exit Function
	For i = 1 To Len(strName)
		c = LCase(Mid(strName, i, 1))
		If InStr("abcdefghijklmnopqrstuvwxyz-.", c) <= 0 And Not IsNumeric(c) Then
			CheckValidEnName = False
			Exit Function
		End If
	Next
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
		CheckInt=""		
	Else
		CheckInt=Int(strNumber)
	End If
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

'------------------------------------------------
'ServerDate(byval strDate)
'服务器时差设置
'回复/留言及发表日志
'接收Trackback
'------------------------------------------------
Function ServerDate(byval strDate)
	Dim intHours
	If Not isDate(strDate) Then Exit Function
	intHours=P_Site_Hours
	If Not isNumeric(intHours) Then 
		intHours=0
		ServerDate=strDate
		Exit Function
	End If
	intHours =Int(intHours)
	If intHours>24 OR intHours<-24 Then 
		intHours=0
		ServerDate=strDate
		Exit Function
	End If
	ServerDate=Dateadd("h",intHours,strDate)	
End Function

'经测试使用此方法比include方法还要慢
Function ReadFileToString(byval oFSO,byval userpath,byval sFile)
'对目录进行处理
'该文件是从最底部开始的
 On Error Resume Next
	Dim oStream
	'处理最顶层的inc
	sFile=Replace(sFile,"..\..\..\..\","")	
	sFile=Replace(sFile,"..\inc\",userpath & "\inc\")
	sFile=Replace(sFile,"calendar\",userpath & "\calendar\")
	sFile=Replace(sFile,"subject\",userpath & "\subject\")
	sFile=Replace(sFile,"archives\",userpath & "\archives\")	
	sFile=Replace(sFile,"\\","\")
	sFile=Replace(sFile,"..\","")
	sFile=Replace(sFile,"\","/")
	sFile=Replace(sFile,"..","")
	'Response.Write "sFile:" & sFile
	'此处暂时不必判断文件是否真实存在
	Set oStream=oFSO.OpenTextFile(Server.Mappath(sFile),1,False)
	ReadFileToString = oStream.ReadAll
	Set oStream=Nothing
	'If Err.Number>0 Then ReadFileToString=""
End Function

	'获取访问者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			
	    GetIP = CheckIP(sIP)
	End Function
12

⌨️ 快捷键说明

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