<% ' ===================================================================================== ' = File: incCheck.asp ' = File Version: 5.1 (beta) ' = Copyright (c)1997-2003 American Web Services, Inc. All rights reserved. ' = Description: ' = Data validation functions ' = Revision History: ' = 14jul2000 (5.1 beta) ssutterfield: general code cleanup/documentation ' = Description of Customizations: ' = Check with Shaun before making any changes to this code ' ===================================================================================== dim FormErrors set FormErrors = CreateObject("Scripting.Dictionary") sub SetAutoCheck(InputName, ChkType, EngName) response.write GetAutoCheckStr(InputName, ChkType, EngName) end sub function GetAutoCheckStr(InputName, ChkType, EngName) if ChkType <> "" then GetAutoCheckStr = "" else GetAutoCheckStr = "" end if end function ' BreakStr() ' will break a string into pieces: e.g. "ABC,DEF,HIJ" into "ABC" "DEF" and "HIJ" ' entry: ' inChkStr = original string to break apart ' inBreakChar = character to break at ' ioPos = starting position: call initially with 0, then pass the value returned by the previous call ' exit: ' outSubStr = the next part of inChkStr, broken at the given character ("" if no more breaks) ' ioPos = the position after outSubStr in inChkStr...use in next call to BreakStr() ' (returns -1 if no more breaks) Sub BreakStr(inChkStr, inBreakChar, outSubStr, ioPos) if ioPos >= 0 then dim pos1 pos1 = InStr(ioPos + 1, inChkStr, inBreakChar) if pos1 > 0 then outSubStr = Trim(Mid(inChkStr, ioPos + 1, pos1 - ioPos - 1)) ioPos = pos1 else outSubStr = Mid(inChkStr, ioPos + 1) ioPos = -1 end if else outSubStr = "" end if End Sub ' AutoCheck() ' Uses the given check string to check all of the form data from an HTML form. ' If the check string is not provided, uses the value of the "aspautocheck" field. ' Typical call is simply: AutoCheck Request, "" ' On exit, FormErrors will contain any data errors Sub AutoCheck(InputRS, inChkStr) if inChkStr = "" then inChkStr = InputRS("aspautocheck") end if dim c, thisChk c = 0 do while true Call BreakStr(inChkStr, ",", thisChk, c) if thisChk <> "" then dim x, strFldName, strChkType, strEngName x = 0 Call BreakStr(thisChk, "|", strFldName, x) Call BreakStr(thisChk, "|", strChkType, x) Call BreakStr(thisChk, "|", strEngName, x) Call CheckField(strFldName, strChkType, InputRS, strEngName) end if if c = -1 then exit do loop End Sub ' CheckFieldX() ' Provided for backwards compatibility with code that didn't provide an error message. ' (uses a generic "Invalid FIELD_NAME" error message) Sub CheckFieldX(strFldName, strCheckType, InputRS) CheckField strFldName, strCheckType, InputRS, "Invalid " & strFldName End Sub ' CheckField() ' Checks the specified field for the specified condition, and adds the specified error message ' to FormErrors if the check fails. strCheckType can be one of the following values: ' isempty - the field must not be empty ' isnumeric - the field must be a number ' isdate - the field must be a date or time ' isemail - the field must be an email address (x@x.x) ' isint - the field must be an integer number (positive or negative, no decimal point) ' ccexp - the field name specifies two names: MONTH_FIELD~YEAR_FIELD, validates that these two fields are not expired ' islengthXXX%YYY - the length of the string must be in the range X-Y ' isintrangeXXX%YYY - the field must be an integer number in the range X-Y ' example: islength4%8 = must be 4 to 6 characters long ' isintrange0%20 - must be a number between 0 and 20 ' Begin strCheckType with "opt" if the field is optional (e.g. optIsNumeric = must be numeric or empty) Sub CheckField(strFldName, byVal strCheckType, InputRS, strErrorText) Dim tmpTest tmpTest = CStr(InputRS(strFldName)) strCheckType = lcase(strCheckType) if left(strCheckType,3) = "opt" then if tmpTest = "" then ' field is optional and was left blank--it is valid exit sub end if strCheckType = mid(strCheckType,4) end if Select Case strCheckType Case "isempty" If tmpTest = "" Then FormErrors.Add strFldName, strErrorText End If Case "isnumeric" If Not IsNumeric(tmpTest) or tmpTest = "" Then FormErrors.Add strFldName, strErrorText End If Case "isdate" If Not IsDate(tmpTest) or tmpTest = "" then FormErrors.Add strFldName, strErrorText End If Case "isemail" If not CheckIsEmail(tmpTest) Then FormErrors.Add strFldName, strErrorText End If Case "isint" tmpTest = TrimZeros(tmpTest) if not IsNumeric(tmpTest) then FormErrors.Add strFldName, strErrorText elseif CStr(CInt(tmpTest)) <> CStr(tmpTest) then FormErrors.Add strFldName, strErrorText end if case "ccexp" CheckCardExp InputRS, strFldName, tmpTest, strErrorText case else if left(strCheckType, 8) = "islength" then ' check if the string is within the given length range dim intRange1, intRange2, c, x strCheckType = mid(strCheckType, 9) c = InStr(strCheckType, "%") if c > 0 then intRange1 = CLng(left(strCheckType, c - 1)) intRange2 = CLng(mid(strCheckType, c + 1)) tmpTest = len(tmpTest) if tmpTest < intRange1 or tmpTest > intRange2 then FormErrors.Add strFldName, strErrorText end if end if elseif left(strCheckType, 10) = "isintrange" then ' check is an integer within the given range ' response.write strChecktype & " " & strFldName & "
" tmpTest = TrimZeros(tmpTest) if not IsNumeric(tmpTest) then FormErrors.Add strFldName, strErrorText ' response.write "error on " & strFldName & " - not numeric
" elseif CStr(CLng(tmpTest)) <> tmpTest then FormErrors.Add strFldName, strErrorText ' response.write "error on " & strFldName & " - not int
" else strCheckType = mid(strCheckType, 11) c = InStr(strCheckType, "%") if c > 0 then intRange1 = CLng(left(strCheckType, c - 1)) intRange2 = CLng(mid(strCheckType, c + 1)) tmpTest = CLng(tmpTest) ' response.write tmpTest & " in range: " & intRange1 & " to " & intRange2 & "
" if tmpTest < intRange1 or tmpTest > intRange2 then FormErrors.Add strFldName, strErrorText ' response.write "error on " & strFldName & ": " & strErrorText & "
" end if end if end if else ' unknown strChecktype err.raise 33000, "Technical Difficulties -- ", "Invalid form checking." end if End Select End Sub ' TrimZeros() - removes all left most zeros (will leave a single zero if that's all that's left) ' Example: "000939300" --> "939300" "0" --> "0" function TrimZeros(strValue) ' inefficient, but effective while left(strValue,1) = "0" and len(strValue) > 1 strValue = mid(strValue,2) wend TrimZeros = strValue end function ' IsCardExpired() - Check if card expiration date has expired function IsCardExpired(strMonth, strYear) dim x, intMonth, intYear, dtmTemp IsCardExpired = true strMonth = strMonth & "" strYear = strYear & "" if not IsNumeric(strMonth) then exit function end if if not IsNumeric(strYear) then exit function end if x = len(strMonth) intMonth = CLng(strMonth) if intMonth < 1 or intMonth > 12 then exit function end if intYear = CLng(strYear) x = len(strYear) if x = 2 then intYear = intYear + 2000 elseif x <> 4 then exit function end if dtmTemp = CDate(intMonth & "/1/" & intYear) dtmTemp = DateAdd("m", 1, dtmTemp) if dtmTemp > Date() then IsCardExpired = false end if end function sub CheckCardExp(rsInput, strFldName, tmpTest, strError) dim strMonthField, strYearField dim strMonth, strYear, x x = InStr(strFldName, "~") if x = 0 then err.raise 33000, "Technical Difficulties -- ", "Invalid form checking" end if strMonthField = left(strFldName, x - 1) strYearField = mid(strFldName, x + 1) strMonth = rsInput(strMonthField) & "" strYear = rsInput(strYearField) & "" if IsCardExpired(strMonth, strYear) then FormErrors.Add strMonthField, strError end if end sub function CheckIsEmail(strValue) ' rules: ' there must be at least one character before the @, at least one character after the @ and before the . ' and at least one character after the . dim c, x CheckIsEmail = false c = InStr(strValue, "@") if c >= 2 then x = InStr(c + 2, strValue, ".") if x > 0 and x < len(strValue) then CheckIsEmail = true end if end if end function %>