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, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
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, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
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
%>
