你的位置: Kiyo'Space首页 ASP 阅读文章 欢迎留下您的足迹

表单验证 for asp

[ ASP ] 分享

以下是引用片段:
<%
Class Validator
‘*************************************************
‘ Validator for ASP beta 2 服务器端脚本
‘ code by 我佛山人
‘ wfsr@cunite.com
‘ http://www.cunite.com
‘*************************************************
 Private Re, Dic
 Private Separator
 Private ErrorItem, ErrorMessage, ErrorMode, ErrorNo
 Private FormName, FormIndex, FilePath, GetMethod

 Private Sub Class_Initialize()
  Set Re = New RegExp
  Re.IgnoreCase = True
  Re.Global = True
  Set Dic = CreateObject("Scripting.Dictionary")
  Separator = ","
  ErrorItem = ""
  ErrorMessage = ""
  ErrorMode = 5
  ErrorNo = 1
  FilePath = Server.MapPath(Request.ServerVariables("Script_Name"))
  GetMethod = "FSO"
 End Sub

 Private Sub Class_Terminate()
  Set Re = Nothing
  Dic.RemoveAll()
  Set Dic = Nothing
 End Sub

 Public Sub Validate()
  IF Request("Submit")="" Then Exit Sub
  IF Not IsValidPost() Then Exit Sub

  With Dic
   .Add "Compare", "Compare( PostValue, operator, toObj)"
   .Add "Custom", "Custom( PostValue,regexp )"
   .Add "Date", "IsDateFormat( PostValue,format )"
   .Add "Limit", "Limit( PostValue,min, max )"
   .Add "LimitB", "LimitB( PostValue,min, max )"
   .Add "Range", "Range( PostValue,min, max )"
   .Add "Repeat", "IsEqual( PostValue, Request(toObj) )"
   .Add "Group", "Group( PostValue,min, max )"

   .Add "NotEqual", "Op1 <> Op2"
   .Add "GreaterThan", "Op1 > Op2"
   .Add "GreaterThanEqual", "Op1 >= Op2"
   .Add "LessThan", "Op1 < Op2"
   .Add "LessThanEqual", "Op1 <= Op2"
   .Add "Equal", "Op1 = Op2"
  End With

  Call MatchCode()

  IF ErrorMessage <> "" Then DisplayError
 End Sub

 Private Sub MatchCode()
  Dim bI, bG, bM
  Dim Str

  Select Case GetMethod
   Case "FSO" :
    Dim FSO : Set FSO = Server.CreateObject("Scripting.FileSystemObject")
    Set TS = FSO.OpenTextFile(FilePath, 1, false)
    Str = TS.ReadAll()
    TS.Close
    Set TS = Nothing
    Set FSO = Nothing
   Case "XMLHTTP" :
    Dim XHttp : Set XHttp = Server.CreateObject("MSXML2.XMLHTTP")
    With XHttp
     Call .Open("Get", "http://"&Request.ServerVariables("Server_Name")&Request.ServerVariables("Script_Name"), False)
     Call .Send()
     Str =B2S(.responseBody)
    End With
    Set XHttp = Nothing
  End Select
  Dim itemString
  With Re
   bI = .IgnoreCase
   bG = .Global
   bM = .MultiLine
   .IgnoreCase = True
   .Global = True
   .Pattern = "[\s\S]*<form [^>]+>([\s\S]+)<\/form>[\s\S]*"
   Str = .Replace(Str, "$1")

   .Global = True
   .MultiLine = True
   .Pattern = "<\/?(?!input|textarea|select)[^>]*>"
   Str = .Replace(Str, "")

   .Pattern = "^.*(<(?=input|textarea|select)[^>]*>).*$"
   Str = .Replace(Str, "$1")

   .Pattern = "([\r\n]+|^\s*)(?=<)"
   Str = .Replace(Str, "")
   While Test("dataType=([""\'])([^""\'>]+)\1", Str)
    .MultiLine = False
    .Pattern = "^([^\n]+)\n([\s\S]*)$"
    itemString = .Replace(Str, "$1")
    Str = .Replace(Str, "$2")
    .Pattern = "(name|dataType|to1|min|max|msg|require|regexp|format)=([""\'])([^""\'>]+)\2"

    Dim Matches : Set Matches = .Execute(itemString)
    Dim Match, RetStr : RetStr = ""
       For Each Match in Matches
       RetStr = RetStr & Match.Value & " : "
       Next
    Call IsValid(Replace(Replace(Replace(RetStr, " : $", ""), "to=", "toObj="), """Require""", """NotEmpty"""))
   Wend
   .IgnoreCase = bI
   .Global = bG
   .MultiLine = bM

  End With
 End Sub

 Private Sub IsValid(ByVal Str)
  Dim name, msg, dataType, toObj, min, max, require, regexp, format
  min = 1 : max = 100 : require = "true" : format = "YMD"
  Execute Str
  Dim PostValue : PostValue = Request(name)
  Dim Fun
  
  IF require = "false" AND PostValue = "" Then Exit Sub

  IF Dic.Exists(dataType) Then 
   Fun = Dic.Item(dataType)
  Else Fun = "Is" & dataType &"( PostValue )"
  End IF

  IF Not Eval(Fun) Then Call AddError(name,msg)
 End Sub

 Private Sub DisplayError()
  ErrorItem = Replace(ErrorItem, "^(" & Separator & ")", "")
  ErrorMessage = Replace(ErrorMessage, "^(" & Separator & ")", "")
  Select Case ErrorMode
   Case 4
    ErrorMessage = Join(Split(ErrorMessage, Separator), "</li><li>")
    Response.Clear
    Response.Write "<div style=""padding-left:100px;font:bold 12px Tahoma"">输入有错误:<br><ul><li>" & Replace(ErrorMessage, "\b\d+:", "") & "</li></ul>"
    Response.Write "<br><a href=’javascript:history.back()’>返回重填</a></div>"
    Response.End
   Case Else
    Response.Write("<script defer>dispError(""" & ErrorItem & """, """ & ErrorMessage & """, " & ErrorMode & ", """ & Separator & """)</script>")
  End Select
 End Sub

 Public Function IsEmail(ByVal Str)
  IsEmail = Test("^\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$", Str)
 End Function

 Public Function IsUrl(ByVal Str)
  IsUrl = Test("^http:\/\/[A-Za-z0-9]+\.[A-Za-z0-9]+[\/=\?%\-&_~`@[\]\’:+!]*([^<>""])*$", Str)
 End Function

 Public Function IsNum(ByVal Str)
  IsNum= Test("^\d+$", Str)
 End Function

 Public Function IsQQ(ByVal Str)
  IsQQ = Test("^[1-9]\d{4,8}$", Str)
 End Function

 Public Function IsZip(ByVal Str)
  IsZip = Test("^[1-9]\d{5}$", Str)
 End Function

 Public Function IsIdCard(ByVal Str)
  IsIdCard = Test("^\d{15}(\d{2}[A-Za-z0-9])?$", Str)
 End Function

 Public Function IsChinese(ByVal Str)
  IsChinese = Test("^[\u0391-\uFFE5]+$", Str)
 End Function

 Public Function IsEnglish(ByVal Str)
  IsEnglish = Test("^[A-Za-z]+$", Str)
 End Function

 Public Function IsMobile(ByVal Str)
  IsMobile = Test("^((\(\d{3}\))|(\d{3}\-))?13\d{9}$", Str)
 End Function

 Public Function IsPhone(ByVal Str)
  IsPhone = Test("^((\(\d{3}\))|(\d{3}\-))?(\(0\d{2,3}\)|0\d{2,3}-)?[1-9]\d{6,7}$", Str)
 End Function

 Public Function IsSafe(ByVal Str)
  IsSafe = (Test("^(([A-Z]*|[a-z]*|\d*|[-_\~!@#\$%\^&\*\.\(\)\[\]\{\}<>\?\\\/\’\""]*)|.{0,5})$|\s", Str) = False)
 End Function

 Public Function IsNotEmpty(ByVal Str)
  IsNotEmpty = LenB(Str) > 0
 End Function

 Public Function IsDateFormat(ByVal Str, ByVal Format)
  IF Not IsDate(Str) Then
   IsDateFormat = False
   Exit Function
  End IF

  IF Format = "YMD" Then
   IsDateFormat = Test("^((\d{4})|(\d{2}))([-./])(\d{1,2})\4(\d{1,2})$", Str)
  Else
   IsDateFormat = Test("^(\d{1,2})([-./])(\d{1,2})\\2((\d{4})|(\d{2}))$", Str)
  End IF
 End Function

 Public Function IsEqual(ByVal Src, ByVal Tar)
  IsEqual = (Src = Tar)
 End Function

 Public Function Compare(ByVal Op1, ByVal Operator, ByVal Op2)
  Compare = False
  IF Dic.Exists(Operator) Then
   Compare = Eval(Dic.Item(Operator))
   Elseif IsNotEmpty(Op1) Then
    Compare = Eval(Op1 &  Operator & Op2 )
  End IF
 End Function

 Public Function Range(ByVal Src, ByVal Min, ByVal Max)
  Min = CInt(Min) : Max = CInt(Max)
  Range = (Min < Src And Src < Max)
 End Function

 Public Function Group(ByVal Src, ByVal Min, ByVal Max)
  Min = CInt(Min) : Max = CInt(Max)
  Dim Num : Num = UBound(Split(Src, ",")) + 1
  Group = Range(Num, Min – 1, Max + 1)
 End Function

 Public Function Custom(ByVal Str, ByVal Reg)
  Custom = Test(Reg, Str)
 End Function

 Public Function Limit(ByVal Str, ByVal Min, ByVal Max)
  Min = CInt(Min) : Max = CInt(Max)
  Dim L : L = Len(Str)
  Limit = (Min <= L And L <= Max)
 End Function

 Public Function LimitB(ByVal Str, ByVal Min, ByVal Max)
  Min = CInt(Min) : Max = CInt(Max)
  Dim L : L =bLen(Str)
  LimitB = (Min <= L And L <= Max)
 End Function

 Private Function Test(ByVal Pattern, ByVal Str)
  Re.Pattern = Pattern
  Test = Re.Test(Str)
 End Function

 Public Function bLen(ByVal Str)
  bLen = Len(Replace(Str, "[^\x00-\xFF]", ".."))
 End Function

 Private Function Replace(ByVal Str, ByVal Pattern, ByVal ReStr)
  Re.Pattern = Pattern
  Replace =  Re.Replace(Str, ReStr)
 End Function

 Private Function B2S(ByVal iStr)
  Dim reVal : reVal= ""
  Dim i, Code, nCode
  For i = 1 to LenB(iStr)
   Code = AscB(MidB(iStr, i, 1))
   IF Code < &h80 Then
    reVal = reVal & Chr(Code)
   Else
    nCode = AscB(MidB(iStr, i+1, 1))
    reVal = reVal & Chr(CLng(Code) * &h100 + CInt(nCode))
    i = i + 1
   End IF
  Next
  B2S = reVal
 End Function

 Private Sub AddError(ByVal Name, ByVal Message)
  ErrorItem = ErrorItem & Separator & Name
  ErrorMessage = ErrorMessage & Separator & ErrorNo & ":" & Message
  ErrorNo = ErrorNo + 1
 End Sub

 Public Function IsValidPost()
  Dim Url1 : Url1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
  Dim Url2 : Url2 = Cstr(Request.ServerVariables("SERVER_NAME"))
  IsValidPost = (Mid(Url1, 8, Len(Url2)) = Url2)
 End Function

 Public Property Let Mode(ByVal Val)
  ErrorMode = CInt(Val)
 End Property

 Public Property Let Form(ByVal Val)
  IF IsNumeric(Val) Then
   FormIndex = Val
  Else
   FormName = Val
  End IF
 End Property

 Public Property Let Path(ByVal Val)
  IF Test("^[A-Za-z]:\\\w+$", Val) Then
   FilePath = Val
  Else
   FilePath = Server.MapPath(Val)
  End IF
 End Property

 Public Property Let Method(ByVal Val)
  GetMethod = Val
 End Property
End Class
%>
 <title>表单验证类 Validator v1.0</title>
 <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
 <style>
 body,td{font:normal 12px Verdana;color:#333333}
 input,textarea,select,td{font:normal 12px Verdana;color:#333333;border:1px solid #999999;background:#ffffff}
 table{border-collapse:collapse;}
 td{padding:3px}
 input{height:20;}
 textarea{width:80%;height:50px;overfmin:auto;}
 form{display:inline}
 </style>
 <script>
 /*************************************************
 Validator for ASP beta 2 客户端脚本
 code by 我佛山人
 wfsr@cunite.com
 http://www.cunite.com
*************************************************/
 function dispError(items, messages, mode, separator){
 var iArray = items.split(separator);
 for(var i=iArray.length-1;i>=0;i–)
  iArray[i] = getObj(iArray[i]);
 messages = ("以下原因导致提交失败:\t\t\t\t" + separator + messages).split(separator);
 switch(mode){
  case 2 :
   for(i=iArray.length-1;i>=0;i–)
    iArray[i].style.color = "red";
  case 1 :
   alert(messages.join("\n"));
   iArray[0].focus();
   break;
  case 3 :
   for(i=iArray.length-1;i>=0;i–){
    try{
     var span = document.createElement("SPAN");
     span.id = "__ErrorMessagePanel";
     span.style.color = "red";
     iArray[i].parentNode.appendChild(span);
     span.innerHTML = messages[i+1].replace(/\d+:/,"*");
    }
    catch(e){alert(e.description);}
   }
   iArray[0].focus();
   break;
 }
 }

 function getObj(name){
 var objs = document.getElementsByName(name);
 return objs[objs.length -1];
 }
</script>
 <form name="theForm" id="demo" action="" method="post" onSubmit="return true">
 <table align="center">
    <tr>
   <td>真实姓名:</td><td><input name="Name" dataType="Chinese" msg="真实姓名只允许中文"></td>
  </tr>
  <tr>
   <td>英文名:</td><td><input name="Nick" dataType="English" require="false" msg="英文名只允许英文字母"></td>
  </tr>
    <tr>
   <td>主页:</td><td><input name="Homepage" require="false" dataType="Url"   msg="非法的Url"></td>
  </tr>
  <tr>
   <td>密码:</td><td><input name="Password" dataType="Safe"   msg="密码不符合安全规则" type="password"></td>
  </tr>
  <tr>
   <td>重复:</td><td><input name="Repeat" dataType="Repeat" to="Password" msg="两次输入的密码不一致" type="password"></td>
  </tr>
  <tr>
   <td>信箱:</td><td><input name="Email" dataType="Email" msg="信箱格式不正确"></td>
  </tr>
    <tr>
   <td>信箱:</td><td><input name="Email1" dataType="Repeat" to="Email" msg="两次输入的信箱不一致"></td>
  </tr>
  <tr>
   <td>QQ:</td><td><input name="QQ" require="false" dataType="QQ" msg="QQ号码不存在"></td>
  </tr>
    <tr>
   <td>身份证:</td><td><input name="Card" dataType="IdCard" msg="身份证号码不正确"></td>
  </tr>
  <tr>
   <td>年龄:</td><td><input name="Year" dataType="Range" msg="年龄必须在18~28之间" min="18" max="28"></td>
  </tr>
   <tr>
   <td>年龄1:</td><td><input name="Year1" require="false" dataType="Compare" msg="年龄必须在18以上" to1="18" operator="GreaterThanEqual"></td>
  </tr>
   <tr>
   <td>电话:</td><td><input name="Phone" require="false" dataType="Phone" msg="电话号码不正确"></td>
  </tr>
   <tr>
   <td>手机:</td><td><input name="Mobile" require="false" dataType="Mobile" msg="手机号码不正确"></td>
  </tr>
     <tr>
   <td>生日:</td><td><input name="Birthday" dataType="Date" format="YMD" msg="生日日期不存在"></td>
  </tr>
   <tr>
   <td>邮政编码:</td><td><input name="Zip" dataType="Custom" regexp="^[1-9]\d{5}$" msg="邮政编码不存在"></td>
  </tr>
  <tr>
   <td>邮政编码:</td><td><input name="Zip1" dataType="Zip" msg="邮政编码不存在"></td>
  </tr>
  <tr>
   <td>操作系统:</td><td><select name="OS" dataType="Require"  msg="未选择所用操作系统" ><option value="">选择您所用的操作系统</option><option value="Win98">Win98</option><option value="Win2k">Win2k</option><option value="WinXP">WinXP</option></select></td>
  </tr>
  <tr>
   <td>所在省份:</td><td>广东<input name="Province" value="1" type="radio">陕西<input name="Province" value="2" type="radio">浙江<input name="Province" value="3" type="radio">江西<input name="Province" value="4" type="radio" dataType="Group"  msg="必须选定一个省份"></td>
  </tr>
  <tr>
   <td>爱好:</td><td>运动<input name="Favorite" value="1" type="checkbox">上网<input name="Favorite" value="2" type="checkbox">听音乐<input name="Favorite" value="3" type="checkbox">看书<input name="Favorite" value="4" type="checkbox" dataType="Group" min="2" max="3"  msg="必须选择2~3种爱好"></td>
  </tr>
  <tr>
   <td>自我介绍:</td><td><textarea name="Description" dataType="Limit" max="10"  msg="自我介绍内容必须在10个字之内">中文是一个字</textarea></td>
  </tr>
  <tr>
     <td>自传:</td><td><textarea name="History" dataType="LimitB" min="3" max="10"  msg="自传内容必须在[3~10]个字节之内">中文是两个字节t</textarea></td>
  </tr>
  <tr>
   <td colspan="2"><input name="Submit" type="submit" value="确定提交"></td>
  </tr>
 </table>
</form>
<%
 Dim V : Set V = New Validator
 V.Mode = 3
 V.Method = "XMLHTTP"
 V.Validate()
 Set V = Nothing
%>
</body>
</html>

 

FROM:http://www.blueidea.com/tech/web/2004/2360.asp

没有评论

  • (Required)
  • (Required, will not be published)