拍拍尘土

<%

Function Get_ScriptNameUrl()
If request.servervariables("SERVER_PORT")="80" Then
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&lcase(request.servervariables("script_name"))
Else
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&lcase(request.servervariables("script_name"))
End If
End Function

  

'=========用正则表达式突出显示字符串中查询到的单词的函数=========
Function BoldWord(strContent,word)
If word="" Then
BoldWord = strContent
Exit Function
End IF
dim objRegExp
Set objRegExp=new RegExp
objRegExp.IgnoreCase =true
objRegExp.Global=True

objRegExp.Pattern="(" & word & ")"
strContent=objRegExp.Replace(strContent,"<font color=""#FF0000""><b>$1</b></font>" )

Set objRegExp=Nothing
BoldWord=strContent
End Function

  

'==========取得用户当前IP地址==========
Function GetIP()
uIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If uIP = "" Then uIP = Request.ServerVariables("REMOTE_ADDR")
GetIp = uIP
End Function

'===========取得当前程序脚本路径=============
Function GetScriptName()
ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME"))'取得当前地址
If (Request.QueryString <> "") Then
ScriptAddress = ScriptAddress & "?" & Server.HTMLEncode(Request.QueryString)'取得带参数地址
End If
If Len(ScriptAddress)>250 Then ScriptAddress = Left(ScirptAddress,250)&"..." '进行路径截取，最大为250个字符
GetScriptName = ScriptAddress
End Function

'========返回带参数的Url，多关键字排序时使用==========
' RemoveList 参数：需要从Url中去除的参数，可以是多个，中间请用逗号隔开
Function KeepUrlStr(RemoveList)
ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME"))&"?"'取得当前地址,并加入“?”符号
M_ItemUrl = ""
For Each M_item In Request.QueryString
If InStr(RemoveList,M_Item)=0 Then
M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&"
End If
Next
KeepUrlStr = ScriptAddress & M_ItemUrl
End Function

'==========过滤HTML代码===========
Function FilterHTML(strToFilter)
Dim strTemp
strTemp = strToFilter
While Instr(1,strTemp,"<") AND Instr(1, strTemp, ">")
strTemp = Left(strTemp, Instr(1, strTemp, "<")-1) & Right(strTemp, Len(strTemp)-Instr(1,strTemp, ">"))
WEnd
FilterHTML = strTemp
End Function

' 以下为常用函数
' ********************************************
' ============================================
' 错误返回处理
' ============================================
Sub Go_Error(str)
   Response.Write "<script language=javascript>alert('" & str & "\n\n系统将自动返回前一页面...');history.back();</script>"
   Response.End
End Sub
' ============================================
' 格式化时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' ============================================
Function Format_Time(s_Time, n_Flag)
   Dim y, m, d, h, mi, s
   Format_Time = ""
   If IsDate(s_Time) = False Then Exit Function
   y = cstr(year(s_Time))
   m = cstr(month(s_Time))
   If len(m) = 1 Then m = "0" & m
   d = cstr(day(s_Time))
   If len(d) = 1 Then d = "0" & d
   h = cstr(hour(s_Time))
   If len(h) = 1 Then h = "0" & h
   mi = cstr(minute(s_Time))
   If len(mi) = 1 Then mi = "0" & mi
   s = cstr(second(s_Time))
   If len(s) = 1 Then s = "0" & s
   Select Case n_Flag
   Case 1
     ' yyyy-mm-dd hh:mm:ss
     Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
   Case 2
     ' yyyy-mm-dd
     Format_Time = y & "-" & m & "-" & d
   Case 3
     ' hh:mm:ss
     Format_Time = h & ":" & mi & ":" & s
   Case 4
     ' yyyy年mm月dd日
     Format_Time = y & "年" & m & "月" & d & "日"
   Case 5
     ' yyyymmdd
     Format_Time = y & m & d
   End Select
End Function
' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
   Dim sTemp
   sTemp = str
   outHTML = ""
   If IsNull(sTemp) = True Then
     Exit Function
   End If
   sTemp = Replace(sTemp, "&", "&amp;")
   sTemp = Replace(sTemp, "<", "&lt;")
   sTemp = Replace(sTemp, ">", "&gt;")
   sTemp = Replace(sTemp, Chr(34), "&quot;")
   sTemp = Replace(sTemp, Chr(10), "<br>")
   outHTML = sTemp
End Function
' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
   Dim sTemp
   sTemp = str
   inHTML = ""
   If IsNull(sTemp) = True Then
     Exit Function
   End If
   sTemp = Replace(sTemp, "&", "&amp;")
   sTemp = Replace(sTemp, "<", "&lt;")
   sTemp = Replace(sTemp, ">", "&gt;")
   sTemp = Replace(sTemp, Chr(34), "&quot;")
   inHTML = sTemp
End Function
' ============================================
' 检测上页是否从本站提交
' 返回:True,False
' ============================================
Function IsSelfRefer()
   Dim sHttp_Referer, sServer_Name
     sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
     sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
     If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
       IsSelfRefer = True
     Else
       IsSelfRefer = False
     End If
End Function
' ============================================
' 得到安全字符串,在查询中使用
' ============================================
Function Get_SafeStr(str)
   Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function
' ============================================
' 取实际字符长度
' ============================================
Function Get_TrueLen(str)
   Dim l, t, c, i
   l = Len(str)
   t = l
   For i = 1 To l
     c = Asc(Mid(str, i, 1))
     If c < 0 Then c = c + 65536
     If c > 255 Then t = t + 1
   Next
   Get_TrueLen = t
End Function
' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
Function IsSafeStr(str)
   Dim s_BadStr, n, i
   s_BadStr = "' 　&<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
   n = Len(s_BadStr)
   IsSafeStr = True
   For i = 1 To n
     If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
       IsSafeStr = False
       Exit Function
     End If
   Next
End Function
'===========================
'转换字符串带有http://的超级链接字符串为真正的超级链接
'===========================
Function LinkURLs(strInput)
   iCurrentLocation = 1
     Do While InStr(iCurrentLocation, strInput, "http://", 1) <> 0
       iLinkStart = InStr(iCurrentLocation, strInput, "http://", 1)
       iLinkEnd = InStr(iLinkStart, strInput, " ", 1)
       If iLinkEnd = 0 Then iLinkEnd = Len(strInput) + 1
         Select Case Mid(strInput, iLinkEnd - 1, 1)
         Case ".", "!", "?"
         iLinkEnd = iLinkEnd - 1
       End Select
       strOutput = strOutput & Mid(strInput, iCurrentLocation, iLinkStart - iCurrentLocation)
       strLinkText = Mid(strInput, iLinkStart, iLinkEnd - iLinkStart)
       strOutput = strOutput & "<a href="""&strLinkText&""">"&strLinkText&"</a>"
       iCurrentLocation = iLinkEnd
     Loop
   strOutput = strOutput & Mid(strInput, iCurrentLocation)
   LinkURLs = strOutput
End Function

'===========================
'函数功能：去掉函数参数中的HTML标记
'===========================
   Function stripHTML(strHTML)
       'Strips the HTML tags from strHTML
     Dim objRegExp, strOutput
     Set objRegExp = New Regexp
     objRegExp.IgnoreCase = True
     objRegExp.Global = True
     objRegExp.Pattern = "<.+?>"
         'Replace all HTML tag matches with the empty string
     strOutput = objRegExp.Replace(strHTML, "")
         'Replace all < and > with < and >
     strOutput = Replace(strOutput, "<", "<")
     strOutput = Replace(strOutput, ">", ">")
     stripHTML = strOutput 'Return the value of strOutput
     Set objRegExp = Nothing
   End Function
''****************************************************
''**应用方法：StripHTML("string")，其中，string为要去掉HTML标记的字符串
''****************************************************
'===========================
'函数功能：去掉函数参数中的HTML标记
'===========================
function nohtml(str)
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(\<.[^\<]*\>)"
str=re.replace(str," ")
re.Pattern="(\<\/[^\<]*\>)"
str=re.replace(str," ")
nohtml=str
set re=nothing
end function
%>