ASP开发中有用的函数（function）集合(1)

ajax · 发表于 2008-10-14 18:19:09

ASP开发中有用的function集合,挺有用处的！希望大家保留！

<%
'*************************************
'防止外部提交
'*************************************
function ChkPost()
  dim server_v1,server_v2
  chkpost=false
  server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
  server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
  If Mid(server_v1,8,Len(server_v2))<>server_v2 then
chkpost=False
  else
chkpost=True
  end If
end function

'*************************************
'IP过滤
'*************************************
function MatchIP(IP)
on error resume next
MatchIP=false
Dim SIp,SplitIP
for each SIp in FilterIP
SIp=replace(SIp,"*","\d*")
SplitIP=split(SIp,".")
Dim re, strMatchs,strIP
   Set re=new RegExp
   re.IgnoreCase =True
   re.Global=True
   re.Pattern="("&SplitIP(0)"|).""("&SplitIP(1)"|).""("&SplitIP(2)"|).""("&SplitIP(3)"|)"
   Set strMatchs=re.Execute(IP)
   strIP=strMatchs(0).SubMatches(0) & "." & strMatchs(0).SubMatches(1)& "." & strMatchs(0).SubMatches(2)& "." & strMatchs(0).SubMatches(3)
   if strIP=IP then MatchIP=true:exit function
   Set strMatchs=Nothing
   Set re=Nothing
next
end function

'*************************************
'获得注册码
'*************************************
Function getcode()
getcode= "<img src=""common/getcode.asp"" alt="""" style=""margin-right:40px;""/>"
End Function

'*************************************
'限制上传文件类型
'*************************************
Function IsvalidFile(File_Type)
IsvalidFile = False
Dim GName
For Each GName in UP_FileType
      If File_Type = GName Then
         IsvalidFile = True
         Exit For
      End If
Next
End Function

'*************************************
'检测是否只包含英文和数字
'*************************************
Function IsValidChars(str)
Dim re,chkstr
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="[^_\.a-zA-Z\d]"
IsValidChars=True
chkstr=re.Replace(str,"")
if chkstr<>str then IsValidChars=False
set re=nothing
End Function

'*************************************
'检测是否只包含英文和数字
'*************************************
Function IsvalidValue(ArrayN,Str)
IsvalidValue = false
Dim GName
For Each GName in ArrayN
      If Str = GName Then
         IsvalidValue = true
         Exit For
      End If
Next
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

'*************************************
'用户名检测
'*************************************
Function IsValidUserName(byVal UserName)
on error resume next
Dim i,c
Dim VUserName
IsValidUserName = True
For i = 1 To Len(UserName)
      c = Lcase(Mid(UserName, i, 1))
      If InStr("$!<>?#^%@~`&*();:+='""? ", c) > 0 Then
            IsValidUserName = False
            Exit Function
      End IF
Next
For Each VUserName in Register_UserName
      If UserName = VUserName Then
         IsValidUserName = False
         Exit For
      End If
Next
End Function

'*************************************
'检测是否有效的E-mail地址
'*************************************
Function IsValidEmail(Email)
Dim names, name, i, c
IsValidEmail = True
Names = Split(email, "@")
If UBound(names) <> 1 Then
      IsValidEmail = False
      Exit Function
End If
For Each name IN names
      If Len(name) <= 0 Then
         IsValidEmail = 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
            IsValidEmail = false
            Exit Function
         End If
      Next
      If Left(name, 1) = "." or Right(name, 1) = "." Then
         IsValidEmail = false
         Exit Function
      End If
Next
If InStr(names(1), ".") <= 0 Then
      IsValidEmail = False
      Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 And i <> 3 Then
      IsValidEmail = False
      Exit Function
End If
If InStr(email, "..") > 0 Then
      IsValidEmail = False
End If
End Function

'*************************************
'加亮关键字
'*************************************
Function highlight(byVal strContent,byRef arrayWords)
Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpdate
if len(arrayWords)<1 then highlight=strContent:exit function
For intPos = 1 to Len(strContent)
      bUpdate = False
      If Mid(strContent, intPos, 1) = "<" Then
         On Error Resume Next
         intTagLength = (InStr(intPos, strContent, ">", 1) - intPos)
         if err then
            highlight=strContent
            err.clear
         end if
         strTemp = strTemp & Mid(strContent, intPos, intTagLength)
         intPos = intPos + intTagLength
      End If
         If arrayWords <> "" Then
            intKeyWordLength = Len(arrayWords)
            If LCase(Mid(strContent, intPos, intKeyWordLength)) = LCase(arrayWords) Then
                  strTemp = strTemp & "<span class=""high1"">" & Mid(strContent, intPos, intKeyWordLength) & "</span>"
                  intPos = intPos + intKeyWordLength - 1
                  bUpdate = True
            End If
         End If
      If bUpdate = False Then
         strTemp = strTemp & Mid(strContent, intPos, 1)
      End If
Next
highlight = strTemp
End Function

		自动登录	找回密码
密码			注册

全国各地医院查询	重量转换换算	RGB颜色查询	交通标志大全	各类快递查询
简体繁体转换	黄金价格实时走势	万年历查询	实时汇率转换	列车时刻查询
在线翻译工具	CSS中文手册	HTML学习教程	MySQL中文手册	JavaScript中文手册
PHP安全基础手册	PHP5面向对象编程教程	正则表达式系统教程	SQL Server精华	Apache 2.2 中文手册
DOS命令全集指南	windows脚本技术中文版	股票行情查询	历史上的今天	邮编区号查询
长度转换换算	货币汇率转换	常用电话号码	体育彩票查询	手机位置查询
域名Whois信息查询	谷歌PR值查询	台州网站建设	台州网站开发	台州域名注册
天气预报查询	长度转换换算器	在线电子地图	车牌号码查询	中国百家姓查询