?? inc_functions.asp
字號:
<%
'此處為非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), " ")
unHtml = Replace(unHtml, " ", " ")
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 & " 分鐘"
Else
'Re do
i = i Mod 24
j = j \ 24
FmtMinutes=j & "天"' & i & " 小時"
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,"ガ","ガ")
strContent=Replace(strContent,"ギ","ギ")
strContent=Replace(strContent,"グ","グ")
strContent=Replace(strContent,"ア","ア")
strContent=Replace(strContent,"ゲ","ゲ")
strContent=Replace(strContent,"ゴ","ゴ")
strContent=Replace(strContent,"ザ","ザ")
strContent=Replace(strContent,"ジ","ジ")
strContent=Replace(strContent,"ズ","ズ")
strContent=Replace(strContent,"ゼ","ゼ")
strContent=Replace(strContent,"ゾ","ゾ")
strContent=Replace(strContent,"ダ","ダ")
strContent=Replace(strContent,"ヂ","ヂ")
strContent=Replace(strContent,"ヅ","ヅ")
strContent=Replace(strContent,"デ","デ")
strContent=Replace(strContent,"ド","ド")
strContent=Replace(strContent,"バ","バ")
strContent=Replace(strContent,"パ","パ")
strContent=Replace(strContent,"ビ","ビ")
strContent=Replace(strContent,"ピ","ピ")
strContent=Replace(strContent,"ブ","ブ")
strContent=Replace(strContent,"ブ","ブ")
strContent=Replace(strContent,"プ","プ")
strContent=Replace(strContent,"ベ","ベ")
strContent=Replace(strContent,"ペ","ペ")
strContent=Replace(strContent,"ボ","ボ")
strContent=Replace(strContent,"ポ","ポ")
strContent=Replace(strContent,"ヴ","ヴ")
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, ">", ">")
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> ")
'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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -