几个常用的ASP函数非常有用省了不省麻烦

获取用户真实IP函数
Function GetIP()
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetIP = "" Then GetIP = Request.ServerVariables("REMOTE_ADDR")
End Function

'获取完整地址栏地址
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function

'获取本页文件名
Function SelfName()
SelfName = Mid(Request.ServerVariables("URL"),InstrRev(Request.ServerVariables("URL"),"/")+1)
End Function

'获取文件后缀名
Function GetExt(filename)
GetExt = Mid(filename,InstrRev(filename,".")+1)
End Function

'求字符串长度函数
Function GetLength(str)
Dim i,length
For i = 1 to Len(str)
If Asc(Mid(str,i,1))<0 or Asc(Mid(str,i,1))>256 Then
length = length+2
Else
length = length+1
End If
Next
GetLength = length
End Function

'过滤不良字符
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "我操|操你|操他|你妈的|他妈的|狗|杂种|屄|屌|王八|强奸|做爱|处女|泽民|法轮|法伦|洪志|法輪"
If Not(IsNull(BadWords) or IsNull(fString)) Then
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
End If
End Function

'防止外部提交
Function ChkPost()
Dim URL1,URL2
ChkPost = False
URL1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
URL2 = Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(URL1,8,Len(URL2))<>URL2 Then
ChkPost = False
Else
ChkPost = True
End If
End Function

'过滤HTML字符函数
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
fString = Replace(fString, "&", "&")
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 = Replace(fString, Chr(255), " ")
HTMLEncode = fString
End If
End Function

'清除HTML标记
Function stripHTML(strHTML)
Dim objRegExp,strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML,"")
strOutput = Replace(strOutput, "<","<")
strOutput = Replace(strOutput, ">",">")
stripHTML = strOutput
Set objRegExp = Nothing
End Function

'检查E-mail是否有效
function isemail(email)
dim names,name,i,c
isemail=true
names=Split(email, "@")
if UBound(names)<>1 then
  isemail=false
  exit function
end if
for each name in names
  if Len(name)<=0 then
   isemail=false
   exit function
  end if
  for i=1 to Len(name)
   c=Lcase(Mid(name,i,1))
   if InStr("abcdefghijklmnopqrstuvwxyz_-.",c)<=0 and not IsNumeric(c) then
    isemail=false
    exit function
   end if
  next
  if Left(name,1)="." or Right(name,1)="." then
   isemail=false
   exit function
  end if
next
if InStr(names(1),".")<=0 then
  isemail=false
  exit function
end if
i=Len(names(1))-InStrRev(names(1),".")
if i<>2 and i<>3 then
  isemail=false
  exit function
end if
if InStr(email,"..")>0 then
  isemail=false
end if
end function

'检测是否有效的数字
Function IsInteger(Para)
IsInteger=False
If Not (IsNull(Para) or Trim(Para)="" or Not IsNumeric(Para)) Then
  IsInteger=True
End If
End Function

几个常用的ASP函数.rar (1.46 kb)