f:\inetpub\wwwreg2\includes\ServerValidation.asp

f:\inetpub\wwwreg2\includes\ServerValidation.asp

0001: <%
0002: Dim g_ErrorMsg
0003: Dim g_ErrorFlag
0004: g_ErrorFlag=false
0005: g_ErrorMsg=""
0006: '---------------------------------------------------------------------------
0007: ' Purpose: Get Form / Query Item
0008: ' Inputs:
0009: ' varItem - Name of the form item (string)
0010: ' if main input (varItem) = "N/A" then it is blank
0011: ' sAliasName - Name to be appeared on the screen on error occured
0012: ' if sAliasName = "" then use sItemName instead.
0013: ' MinLength, MaxLength: Minimum & Maximum Length of the string
0014: ' respectively
0015: ' bRequired: is the Item
0016: ' Returns:
0017: ' The processed value for applicable functions,
0018: ' Stacked error message on g_ErrorMsg.
0019: ' Used for displaying all errors in a message
0020: ' g_ErrorFlag is set true each time an error has occured per function call.
0021: ' Used when you must know if a specific input item has failed during validation
0022: ' Set the g_ErrorFlag=false
0023: ' Validate
0024: ' Check if g_ErrorFlag=true (failure)
0025: ' Last entered value at Session(sItemName)
0026: '
0027: ' Procedures & Functions:
0028: '
0029: ' fValidateValue - Generic Checks required and length of input. Returns Input and g_ErrorFlag is set true on failure
0030: ' fValidAlphaValue - Alphabetic Checks required and Alphabetic within range. Returns Input and g_ErrorFlag is set true on failure
0031: ' fValidAlphaNumericValue - Alphanumeric Checks required and Alphanumeric within range. Returns Input and g_ErrorFlag is set true on failure
0032: ' fValidDateValue - Date Checks required and date within range. Returns Input and g_ErrorFlag is set true on failure
0033: ' fValidNumValue - Number Checks required and Numbers within range. Returns Input and g_ErrorFlag is set true on failure
0034: ' fValidPercValue - Percent Checks required and percentages within range converts and returns value and g_ErrorFlag is set true on failure
0035: ' fValidPhoneNumber - Phone Number Checks required, length and limits valid strings, returns value and g_ErrorFlag is set true on failure
0036: ' Set maxlength to reflect the Digits allowed
0037: ' fValidUSZip - Zip Code Checks required, length and limits valid strings for US Zip code returns value and g_ErrorFlag is set true on failure
0038: ' Set maxlength to reflect the Digits allowed
0039: ' fValidSelectValue - Generic Checks select list for non-blank input to ensure a value was selected.
0040: ' Use null as the default for select lists using this function.
0041: ' Returns Input and g_ErrorFlag is set true on failure
0042: ' fServerSidePasswordValidation - Compares two password inputs to confirm they are the same. Returns Input and g_ErrorFlag is set true on failure
0043: ' fServerSideEmailValidation - Validates email address. Returns Input and g_ErrorFlag is set true on failure
0044: ' fAlphaClean - Cleans invalid characters and numbers from the alphabetical input Returns Cleaned Text
0045: ' fTextClean - Cleans invalid characters from the input Returns Cleaned Text
0046: ' fNumberClean - Cleans strings to get valid number values from the input Returns Cleaned Number -returns zero for blank inputs
0047: ' fNumberCleanLeaveBlank - Cleans strings to get valid number values from the input Returns Cleaned Number
0048: ' fSpaceClean - Removes Spaces from the string
0049: '
0050: ' SubProcedures & SubFunctions:
0051: '
0052: ' fCleanText - Checks text for invalid characters, returns 0 if the string is approved
0053: ' sDateValidate - Writes error message for blank date inputs
0054: ' sMinMaxDateValidate - Writes error message for dates out of range
0055: ' sNumValidate - Writes error message for blank number inputs
0056: ' sMinMaxNumValidate - Writes error message for numbers out of range
0057: ' sMinMaxValidate - writes error message for strings with length out of range
0058: ' sAlphaValidate - writes error message for strings with non-alphabetic characters
0059: ' sAlphaNumericValidate - writes error message for strings with non-alphanumeric characters
0060: '
0061: ' fisAlpha - returns false if the input string has non: alphanumeric or space characters
0062: ' fisAlphanumeric - returns false if the input string has non :alphanumeric, numbers or space characters
0063: ' fStandardizePercent - Numbers greater than 1 are divided by 100 and returned
0064: ' fMakeNumeric - Returns only the numeric characters of the input. Returns 0 if no numerics were present.
0065: ' fMakeDigits - Returns only the numeric characters of the input.
0066: '
0067: '
0068: '---------------------------------------------------------------------------
0069: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0070: 'validate item if value is passed
0071: Function fValidateValue(byVal varItem , sAliasName, iMinLength, iMaxLength, fRequired)
0072: Dim MsgLen
0073: MsgLen=Len(g_ErrorMsg)
0074: varitem=trim(varitem)
0075: if sAliasName="" then sAliasName=varItem
0076: if UCASE(varItem) = "N/A" then varItem=""
0077: fRequired=cbool(fRequired)
0078: Select Case fRequired
0079: Case True
0080: If varItem = "" Then
0081: if ((CDbl(iMinLength) >0) and (iMinLength<>iMaxLength)) then
0082: g_ErrorMsg = g_ErrorMsg & "Please enter between "&iMinLength&" and "& iMaxLength &" characters in the """ _
0083: & sAliasName & """ field. \n"
0084: else
0085: g_ErrorMsg = g_ErrorMsg & "Please enter characters in the """ & sAliasName & """ field. \n"
0086: end if
0087:
0088: Else
0089: Call sMinMaxvalidate(varitem, sAliasName, iMinLength, iMaxLength)
0090: End If
0091: Case False
0092: If varitem<>"" then
0093: Call sMinMaxvalidate(varitem, sAliasName, iMinLength, iMaxLength)
0094: End If
0095: End Select
0096: If varitem<>"" then
0097: Session(varitem) = varItem
0098: End if
0099: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0100: fValidateValue=varItem
0101: End Function
0102: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0103: 'Subprocedure for string validate
0104: Sub sMinMaxvalidate(byVal varItem, sAliasName, iMinLength, iMaxLength)
0105:
0106: If Len(varItem) < cdbl(iMinLength) Then
0107: g_ErrorMsg = g_ErrorMsg & "Please enter at least "& iMinLength &" characters in the """ & sAliasName & """ field. \n"
0108:
0109: Elseif Len(varItem) > cdbl(iMaxLength) Then
0110: g_ErrorMsg = g_ErrorMsg & "Please enter at most " & iMaxLength &" characters in the """ & sAliasName & """ field. \n"
0111:
0112: End if
0113: End Sub
0114:
0115: 'Sub level functions for Alphabetic validation errors
0116: Sub sAlphaValidate(byVal varItem, sAliasName)
0117: if varitem="" then
0118: g_ErrorMsg = g_ErrorMsg & " Please enter a value in the """ _
0119: & sAliasName & """ field. \n"
0120: else
0121: g_ErrorMsg = g_ErrorMsg _
0122: & "Only the letters A through Z, dash, apostrophe and space are allowed in the """ _
0123: & sAliasName & """ field. \n"
0124: end if
0125: End Sub
0126: 'Sub level functions for Alphanumeric validation errors
0127: Sub sAlphaNumericValidate(byVal varItem, sAliasName)
0128: if varitem="" then
0129: g_ErrorMsg = g_ErrorMsg & " Please enter a value in the """ _
0130: & sAliasName & """ field. \n"
0131: else
0132: g_ErrorMsg = g_ErrorMsg _
0133: & "Only the letters A through Z, 0 through 9, slash and space are allowed in the """ _
0134: & sAliasName & """ field. \n"
0135: end if
0136: End Sub
0137: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0138: ' Validate select list to ensure an item has been selected
0139: Function fValidSelectValue(byVal varItem , sAliasName, fRequired)
0140: Dim MsgLen
0141: MsgLen=Len(g_ErrorMsg)
0142: if UCASE(varItem) = "N/A" then varItem=""
0143: varitem=trim(varitem)
0144: fRequired=cbool(fRequired)
0145: if sAliasName="" then sAliasName=varItem
0146: If fRequired and (varItem="" or varItem="Select") then
0147: g_ErrorMsg = g_ErrorMsg & "Please select a value from the """ & sAliasName & """ list. \n"
0148: End If
0149:
0150: If varitem<>"" then
0151: Session(varitem) = varItem
0152: End if
0153: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0154: fValidSelectValue= varItem
0155: End Function
0156: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0157:
0158: 'validate Alphabetic item if value is passed
0159: Function fValidAlphaValue(byVal varItem , sAliasName, iMinValue, iMaxValue, fRequired)
0160: Dim MsgLen
0161: MsgLen=Len(g_ErrorMsg)
0162: if UCASE(varItem) = "N/A" then varItem=""
0163: if sAliasName="" then sAliasName=varItem
0164: if isnumeric(iMinValue) then
0165: iMinValue=cdbl(iMinValue)
0166: else
0167: iMinValue=0
0168: end if
0169: If isnumeric(iMaxValue) then
0170: iMaxValue=cdbl(iMaxValue)
0171: else
0172: iMaxValue=50
0173: end if
0174: fRequired=cbool(fRequired)
0175:
0176: Select Case fRequired
0177: Case True
0178: If varItem = "" or not fisAlpha(varitem)Then
0179: Call sAlphaValidate(varItem, sAliasName)
0180: Elseif varitem<>"" then
0181: Call sMinMaxValidate(varItem, sAliasName, iMinValue, iMaxValue)
0182: end if
0183: 'check if the value is not required but has a value
0184: Case False
0185: If varitem<>"" then
0186: If not fisAlpha(varitem) Then
0187: Call sAlphaValidate(varItem, sAliasName)
0188: Else
0189: Call sMinMaxvalidate(varItem, sAliasName, iMinValue, iMaxValue)
0190:
0191: End If
0192: End If
0193: End Select
0194:
0195: if varitem<>"" then
0196: Session(varitem) = varItem
0197: end if
0198: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0199: fValidAlphaValue=varItem
0200: End Function
0201: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0202:
0203: 'validate Alphabetic item if value is passed
0204: Function fValidAlphaNumericValue(byVal varItem , sAliasName, iMinValue, iMaxValue, fRequired)
0205: Dim MsgLen
0206: MsgLen=Len(g_ErrorMsg)
0207: if UCASE(varItem) = "N/A" then varItem=""
0208: if sAliasName="" then sAliasName=varItem
0209: if isnumeric(iMinValue) then
0210: iMinValue=cdbl(iMinValue)
0211: else
0212: iMinValue=0
0213: end if
0214: If isnumeric(iMaxValue) then
0215: iMaxValue=cdbl(iMaxValue)
0216: else
0217: iMaxValue=50
0218: end if
0219: fRequired=cbool(fRequired)
0220:
0221: Select Case fRequired
0222: Case True
0223: If varItem = "" or not fisAlphaNumeric(varitem)Then
0224: Call sAlphaNumericValidate(varItem, sAliasName)
0225: Elseif varitem<>"" then
0226: Call sMinMaxValidate(varItem, sAliasName, iMinValue, iMaxValue)
0227: end if
0228: 'check if the value is not required but has a value
0229: Case False
0230: If varitem<>"" then
0231: If not fisAlphaNumeric(varitem) Then
0232: Call sAlphaNumericValidate(varItem, sAliasName)
0233: Else
0234: Call sMinMaxvalidate(varItem, sAliasName, iMinValue, iMaxValue)
0235:
0236: End If
0237: End If
0238: End Select
0239:
0240: if varitem<>"" then
0241: Session(varitem) = varItem
0242: end if
0243: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0244: fValidAlphaNumericValue=varItem
0245: End Function
0246: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0247: 'validate Dateitem if value is passed
0248: Sub fValidDateValue(byVal varItem, sAliasName, iMinDate, iMaxDate, fRequired)
0249: Dim MsgLen
0250: MsgLen=Len(g_ErrorMsg)
0251: varitem=trim(varitem)
0252: if UCASE(varItem) = "N/A" then varItem=""
0253: fRequired=cbool(fRequired)
0254: if sAliasName="" then sAliasName=varItem
0255: if isnull(iMinDate) or not isdate(iMindate) then
0256: iMinDate="1/1/2003"
0257: end if
0258: if isnull(iMaxDate) or not isdate(iMaxdate) then
0259: iMaxDate="1/1/2079"
0260: end if
0261: iMinDate=cDate(iMinDate)
0262: iMaxDate=cDate(iMaxDate)
0263: Select Case fRequired
0264: Case True
0265: If varItem = "" or not isdate(varitem) Then
0266: Call sDateValidate(varitem, sAliasName, iMinDate, iMaxDate)
0267: Elseif varItem<>"" then
0268: Call sMinMaxDateValidate(varitem, sAliasName, iMinDate, iMaxDate)
0269: End if
0270: Case False
0271: If varItem<>"" then
0272: If not isdate(varitem) Then
0273: Call sDateValidate(varitem, sAliasName, iMinDate, iMaxDate)
0274: Else
0275: Call sMinMaxDateValidate(varitem, sAliasName, iMinDate, iMaxDate)
0276: End If
0277: End IF
0278: End Select
0279: If varitem<>"" then
0280: Session(varitem) = varItem
0281: End if
0282: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0283: fValidDateValue=varItem
0284: End Sub
0285: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0286: 'Sub level functions for date validation errors
0287: Sub sDateValidate(byVal varitem, sAliasName, iMinDate, iMaxDate)
0288: g_ErrorMsg = g_ErrorMsg _
0289: & "Please enter a date between "&iMinDate&" and "&iMaxDate&" in the """ _
0290: & sAliasName & """ field. \n"
0291: End Sub
0292: Sub sMinMaxDateValidate(byVal varitem, sAliasName, iMinDate, iMaxDate)
0293: If Cdate(varItem) < iMinDate Then g_ErrorMsg = _
0294: g_ErrorMsg & "Please enter a date greater than " _
0295: & iMinDate &" in the""" _
0296: & sAliasName & """ field. \n"
0297: If Cdate(varItem) > iMaxDate Then g_ErrorMsg = _
0298: g_ErrorMsg & "Please enter a date sooner than " _
0299: & iMaxDate &" in the """ _
0300: & sAliasName & """ field. \n"
0301: end sub
0302: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0303:
0304:
0305: 'validate Numberitem if value is passed
0306: Function fValidNumValue(byVal varItem , sAliasName, iMinValue, iMaxValue, fRequired)
0307: Dim MsgLen
0308: MsgLen=Len(g_ErrorMsg)
0309: if UCASE(varItem) = "N/A" then varItem=""
0310: if sAliasName="" then sAliasName=varItem
0311: if isnumeric(iMinValue) then
0312: iMinValue=cdbl(iMinValue)
0313: else
0314: iMinValue=0
0315: end if
0316: If isnumeric(iMaxValue) then
0317: iMaxValue=cdbl(iMaxValue)
0318: else
0319: iMaxValue=19999999999
0320: end if
0321: fRequired=cbool(fRequired)
0322:
0323: if fCleanText(varitem)>0 then g_ErrorMsg= g_ErrorMsg & "Please remove commas and other extra characters in the """ _
0324: & sAliasName & """ field. \n"
0325:
0326: Select Case fRequired
0327: Case True
0328: If varItem = "" or not isnumeric(varitem)Then
0329: Call sNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0330: Elseif varitem<>"" then
0331: Call sMinMaxNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0332: end if
0333: 'check if the value is not required but has a value
0334: Case False
0335: If varitem<>"" then
0336: If not isnumeric(varitem) Then
0337: Call sNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0338: Else
0339: Call sMinMaxNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0340:
0341: End If
0342: End If
0343: End Select
0344:
0345: if varitem<>"" then
0346: Session(varitem) = varItem
0347: end if
0348: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0349: fValidNumValue=varItem
0350: End Function
0351: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0352: 'Sub level functions for Number validation errors
0353: Sub sNumValidate(byVal varItem, sAliasName, iMinValue, iMaxValue)
0354: g_ErrorMsg = g_ErrorMsg _
0355: & "Please enter a value between "&iMinValue&" and "& iMaxValue&" in the """ _
0356: & sAliasName & """ field. \n"
0357: End Sub
0358: Sub sMinMaxNumValidate(byVal varItem, sAliasName, iMinValue, iMaxValue)
0359: If cdbl(varItem) < iMinValue Then g_ErrorMsg = _
0360: g_ErrorMsg & "Please enter a value greater than " _
0361: & iMinValue &" in the""" _
0362: & sAliasName & """ field. \n"
0363: If cdbl(varItem) > iMaxValue Then g_ErrorMsg = _
0364: g_ErrorMsg & "Please enter a value less than " _
0365: & iMaxValue &" in the """ _
0366: & sAliasName & """ field. \n"
0367: End Sub
0368: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0369: function fValidPercValue(byVal varitem , sAliasName, iMinValue, iMaxValue, fRequired)
0370: dim location
0371: Dim MsgLen
0372: MsgLen=Len(g_ErrorMsg)
0373: varitem=cstr(varitem)
0374: if UCASE(varitem) = "N/A" then varitem=""
0375: if sAliasName="" then sAliasName=varItem
0376: location = instr(1,varitem,chr(37),1)
0377: if location >0 then
0378: varitem=left(varitem,(location-1))
0379: varitem=cdbl(varitem)/100
0380: end if
0381: iMinValue=cdbl(iMinValue)
0382: iMaxValue=cdbl(iMaxValue)
0383: fRequired=cbool(fRequired)
0384: If sAliasName = "" Then sAliasName = sItemName
0385: Select Case fRequired
0386: Case True
0387: If varItem = "" or not isnumeric(varitem) Then
0388: Call sNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0389: varitem=0
0390: ElseIf varitem<>"" then
0391: varitem=fStandardizePercent(cdbl(varitem))
0392: Call sMinMaxNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0393: End If
0394: Case False
0395: If varItem<>"" then
0396:
0397: If not isnumeric(varitem) Then
0398: Call sNumValidate(varItem, sAliasName, iMinValue, iMaxValue)
0399: Else
0400: varitem=cdbl(varitem)
0401: if varitem>1 then
0402: varitem=varitem/100
0403: end if
0404: Call sMinMaxNumValidate(varItem ,sAliasName, iMinValue, iMaxValue)
0405: End If
0406: End If
0407: End Select
0408: Session(cstr(varitem)) = varItem
0409: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0410: fValidPercValue=varitem
0411: End function
0412: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0413: '----------------------------------------------------------------
0414: ' Purpose: Validate Both Password field, usually used for new registration.
0415: ' Inputs :
0416: ' sPassword1 : name of the first password input box
0417: ' sPassword2 : name of the 2nd password input box
0418: ' iMin, iMax: Minimum & Maximum characters allowed respectively
0419: ' bRequired : True/False, is required value?
0420: ' usually, always TRUE
0421: ' Return :
0422: ' True/False
0423: ' error message on g_ErrorMsg and
0424: '----------------------------------------------------------------
0425:
0426: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0427: 'validate passwords when passed as values
0428: Function fServerSidePasswordValidation (byVal sPassword1,byVal sPassword2, iMin, iMax,bRequired)
0429: Dim MsgLen
0430: MsgLen=Len(g_ErrorMsg)
0431: Call fValidateValue(sPassword1, "Password", iMin, iMax, bRequired)
0432: Call fValidateValue(sPassword2, "Verify Password", iMin, iMax, bRequired)
0433:
0434: bValidPassword = ( session(sPassword1) = session(sPassword2) )
0435: if Not bValidPassword Then g_ErrorMsg = _
0436: g_ErrorMsg _
0437: & " Both Password fields must has the same value! \n"
0438: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0439: fServerSidePasswordValidation = sPassword1
0440: End Function
0441:
0442: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0443: ' Validate the email address when passed as the actual value
0444: Function fServerSideEmailValidation (byVal sItemValue, sAliasName, iMinLength, iMaxLength, bRequired)
0445: Dim MsgLen, AmpPos, ItemLen
0446: MsgLen=Len(g_ErrorMsg)
0447: AmpPos=InStr(sItemValue,"@")
0448: ItemLen=Len(sItemValue)
0449: sitemValue=trim(sitemValue)
0450: if sAliasName="" then sAliasName=sItemValue
0451: Call fValidateValue (sItemValue, sAliasName, iMinLength, iMaxLength, bRequired)
0452: if sItemValue<>"" then
0453: If (AmpPos < 2) Then
0454: g_ErrorMsg = g_ErrorMsg & sAliasName &" must be a valid Email address (Invalid or Missing @) \n"
0455: Elseif InStr(Right(sItemValue,(ItemLen - AmpPos)),"@")<>0 then
0456: g_ErrorMsg = g_ErrorMsg & sAliasName &" must be a valid Email address (Only one @ character is allowed) \n"
0457: ElseIf ( InStr(InStr(sItemValue,"@"),sItemValue,".") < InStr(sItemValue,"@")+2 ) Then
0458: g_ErrorMsg = g_ErrorMsg & sAliasName &" must be a valid Email address (Invalid or Missing .) \n"
0459: ElseIf right(sItemValue,1)="." then
0460: g_ErrorMsg = g_ErrorMsg & sAliasName &" must be a valid Email address (cannot end with .) \n"
0461: ElseIf left(sItemValue,1)="." then
0462: g_ErrorMsg = g_ErrorMsg & sAliasName &" must be a valid Email address (cannot start with .) \n"
0463: Elseif Instr(sItemValue,"..")>0 then
0464: g_ErrorMsg = g_ErrorMsg & sAliasName &" must be a valid Email address (periods cannot be next to each other) \n"
0465: End If
0466: end if
0467: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0468: fServerSideEmailValidation = sItemValue
0469: End Function
0470: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0471: Function fCleanText(byVal inputedStr)
0472: dim BadCharactersForRemoval, RemoveWords, counta
0473: if UCASE(inputedStr) = "N/A" then inputedStr=""
0474: 'Modify These if you want, but don't blame me if it goes pear shapped!
0475: if len(inputedStr)>0 then
0476: BadCharactersForRemoval = "$|,|;|#|%|>|/|\|&|'|*|^|!|?|}|{|]|[|<|_"
0477: RemoveWords = Split(BadCharactersForRemoval, "|")
0478: fCleanText = 0
0479: For Counta = 0 to UBound(RemoveWords)
0480: fCleanText= fCleanText + instr(1,inputedStr,RemoveWords(Counta))
0481: Next
0482: end if
0483: End Function
0484: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0485: Function fSpaceClean(byVal inputedStr)
0486: fSpaceClean=replace(inputedStr," ","",1,-1,1)
0487: end Function
0488: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0489: Function fTextClean(byVal inputedStr)
0490: dim BadCharactersForRemoval, RemoveWords, counta
0491: if UCASE(inputedStr) = "N/A" then inputedStr=""
0492: 'Modify These if you want, but don't blame me if it goes pear shapped!
0493: if len(inputedStr)>0 then
0494: BadCharactersForRemoval = "$|,|;|#|%|>|\|&|'|*|^|!|?|}|{|]|[|<|_"
0495: RemoveWords = Split(BadCharactersForRemoval, "|")
0496: For Counta = 0 to UBound(RemoveWords)
0497: inputedStr = Replace(inputedStr, RemoveWords(Counta), "", 1,-1,1)
0498: Next
0499: end if
0500: fTextClean=inputedStr
0501: End Function
0502: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0503: Function fAlphaClean(byVal inputedStr)
0504: dim BadCharactersForRemoval, RemoveWords, counta
0505: dim BadCharactersForReplacement, ReplaceWords, ReplacementCharacters, ReplacedWords
0506: if UCASE(inputedStr) = "N/A" then inputedStr=""
0507: 'Modify These if you want, but don't blame me if it goes pear shapped!
0508: if len(inputedStr)>0 then
0509: BadCharactersForRemoval = "$|,|;|#|%|>|\|&|*|^|!|?|}|{|]||(|)|[|<|@|.|~|?|/|=|+|_|0|1|2|3|4|5|6|7|8|9"
0510: BadCharactersForReplacement = "'"
0511: ReplacementCharacters= "`"
0512: RemoveWords = Split(BadCharactersForRemoval, "|")
0513: ReplaceWords = Split(ReplacementCharacters, "|")
0514: ReplacedWords = Split(BadCharactersForReplacement, "|")
0515: For Counta = 0 to UBound(RemoveWords)
0516: inputedStr = Replace(inputedStr, RemoveWords(Counta), "", 1,-1,1)
0517: Next
0518: For Counta = 0 to UBound(ReplaceWords)
0519: inputedStr = Replace(inputedStr, ReplacedWords(Counta), ReplaceWords(Counta), 1,-1,1)
0520: Next
0521: end if
0522: fAlphaClean=inputedStr
0523: End Function
0524: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0525: Function fNumberClean(byVal inputedStr)
0526: dim BadCharactersForRemoval, RemoveWords, Counta
0527: dim BadCharactersForReplacement, ReplaceWords, ReplacementCharacters, ReplacedWords
0528: if UCASE(inputedStr) = "N/A" or inputedStr ="" then inputedStr="0"
0529: 'Modify These if you want, but don't blame me if it goes pear shapped!
0530: if len(inputedStr)>0 then
0531: BadCharactersForRemoval = "$|,|;|#|%|>|\|&|'|.00|(|)|<|*|_|[|]|{|}"
0532: BadCharactersForReplacement = "..|k|K"
0533: ReplacementCharacters= ".|000|000"
0534: RemoveWords = Split(BadCharactersForRemoval, "|")
0535: ReplaceWords = Split(ReplacementCharacters, "|")
0536: ReplacedWords = Split(BadCharactersForReplacement, "|")
0537: For Counta = 0 to UBound(RemoveWords)
0538: inputedStr = Replace(inputedStr, RemoveWords(Counta), "", 1,-1,1)
0539: Next
0540: For Counta = 0 to UBound(ReplaceWords)
0541: inputedStr = Replace(inputedStr, ReplacedWords(Counta), ReplaceWords(Counta), 1,-1,1)
0542: Next
0543: end if
0544: fNumberClean=inputedStr
0545: End Function
0546: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0547: Function fNumberCleanLeaveBlank(byVal inputedStr)
0548: dim BadCharactersForRemoval, RemoveWords, Counta
0549: dim BadCharactersForReplacement, ReplaceWords, ReplacementCharacters, ReplacedWords
0550: if UCASE(inputedStr) = "N/A" then inputedStr="0"
0551: 'Modify These if you want, but don't blame me if it goes pear shapped!
0552: if len(inputedStr)>0 then
0553: BadCharactersForRemoval = "$|,|;|#|%|>|\|&|'|.00|(|)|<|*|_|[|]|{|}"
0554: BadCharactersForReplacement = "..|k|K"
0555: ReplacementCharacters= ".|000|000"
0556: RemoveWords = Split(BadCharactersForRemoval, "|")
0557: ReplaceWords = Split(ReplacementCharacters, "|")
0558: ReplacedWords = Split(BadCharactersForReplacement, "|")
0559: For Counta = 0 to UBound(RemoveWords)
0560: inputedStr = Replace(inputedStr, RemoveWords(Counta), "", 1,-1,1)
0561: Next
0562: For Counta = 0 to UBound(ReplaceWords)
0563: inputedStr = Replace(inputedStr, ReplacedWords(Counta), ReplaceWords(Counta), 1,-1,1)
0564: Next
0565: end if
0566: fNumberCleanLeaveBlank=inputedStr
0567: End Function
0568: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0569: Function fValidPhoneNumber(byVal varItem, sAliasName, iMinLength, iMaxLength, bRequired)
0570: Dim GoodWord, GoodCharacter, i
0571: Dim MsgLen
0572: MsgLen=Len(g_ErrorMsg)
0573: if UCASE(varItem) = "N/A" then varItem=""
0574: varitem=trim(varItem)
0575: if sAliasName="" then sAliasName=varItem
0576: GoodWord=true
0577: if iMinLength > 8 then
0578: For i = 1 to Len(varItem)
0579: GoodCharacter = mid(varItem,i,1)
0580: if Not IsNumeric(GoodCharacter) and ( (i<>4 and i<>1 and i<>5 and i<>6 and i<>8 and i<>9 and i<>10) or (GoodCharacter <>"(" and GoodCharacter <>")" and GoodCharacter <>"-" and GoodCharacter<>"." and Goodcharacter<>" ")) then
0581: GoodWord=false
0582: varItem=replace(varItem,GoodCharacter,"")
0583: end if
0584: Next
0585: else
0586: For i = 1 to Len(varItem)
0587: GoodCharacter = mid(varItem,i,1)
0588: if Not IsNumeric(GoodCharacter) and ( i<>4 or (GoodCharacter <>"(" and GoodCharacter <>")" and GoodCharacter <>"-" and GoodCharacter<>"." and Goodcharacter<>" ")) then
0589: GoodWord=false
0590: varItem=replace(varItem,GoodCharacter,"")
0591: end if
0592: Next
0593: end if
0594: if GoodWord then
0595: if varItem <= iMinLength or iMinLength=iMaxLength then
0596: Call fValidateValue(fMakeDigits(varItem), sAliasName, iMinLength, iMaxLength, bRequired)
0597: else
0598: Call fValidateValue(fMakeDigits(varItem), sAliasName, iMinLength, iMaxLength-1, bRequired)
0599: end if
0600: Else
0601: g_ErrorMsg = g_ErrorMsg &"Please input a valid phone number into the '"& sAliasName &"' Field. \n"
0602: End IF
0603: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0604: fValidPhoneNumber=varItem
0605: End Function
0606: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0607: Function fValidUSZip(byVal varItem, sAliasName, iMinLength, iMaxLength, bRequired)
0608: Dim GoodWord, GoodCharacter, i
0609: Dim MsgLen, ItemLen
0610: MsgLen=Len(g_ErrorMsg)
0611: ItemLen=len(varItem)
0612: varitem=trim(varItem)
0613: if sAliasName="" then sAliasName=varItem
0614: GoodWord=true
0615: For i = 1 to Len(varitem)
0616: GoodCharacter = mid(varItem,i,1)
0617: if Not IsNumeric(GoodCharacter) and (i<>6 or (GoodCharacter <>"-" and GoodCharacter<>" ")) then
0618: GoodWord=false
0619: varItem=replace(varItem,GoodCharacter,"",i,1)
0620: end if
0621: Next
0622: if GoodWord then
0623: if ItemLen <= iMinLength then
0624: Call fValidateValue(fMakeDigits(varItem), sAliasName, iMinLength, iMinLength, bRequired)
0625: else
0626: Call fValidateValue(fMakeDigits(varItem), sAliasName, iMaxLength-1, iMaxLength, bRequired)
0627: end if
0628: Else
0629: g_ErrorMsg = g_ErrorMsg &"Please input a valid US Zip Code into the '"& sAliasName &"' Field. \n"
0630: End IF
0631: if Len(g_ErrorMsg) >MsgLen then g_ErrorFlag=true
0632: fValidUSZip=varItem
0633: End Function
0634:
0635: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0636: Function fMakeDigits(byVal Data)
0637: Dim n
0638: 'STRIP ALL NON-NUMERICS
0639: For n = 1 To Len(Data)
0640: If IsNumeric(Mid(Data, n, 1)) or Mid(Data, n, 1)="." Then
0641: fMakeDigits = fMakeDigits & Mid(Data, n, 1)
0642: End If
0643: Next
0644: End Function
0645: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0646: Function fisAlphaNumeric(inStr)
0647: dim RegAN
0648: set RegAN = new RegExp
0649: RegAN.Pattern = "^[a-zA-Z0-9 .#/-]+$"
0650: fisAlphaNumeric = RegAN.test(inStr)
0651: End Function
0652: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0653: Function fisAlpha(inStr)
0654: dim RegA
0655: set RegA = new RegExp
0656: RegA.Pattern = "^[a-zA-Z .`-]+$"
0657: fisAlpha = RegA.test(inStr)
0658: End Function
0659: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0660: 'Stolen Functions from other pages
0661: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0662: Function fMakeNumeric(byVal Data)
0663: Dim n
0664: 'REPLACE ALL "K" WITH THREE ZEROS
0665: Data=Replace(Data,"K","000")
0666: Data=Replace(Data,"k","000")
0667:
0668: 'STRIP ALL NON-NUMERICS
0669: For n = 1 To Len(Data)
0670: If IsNumeric(Mid(Data, n, 1)) or Mid(Data, n, 1)="." Then
0671: fMakeNumeric = fMakeNumeric & Mid(Data, n, 1)
0672: End If
0673: Next
0674:
0675: 'ASSIGN A VALUE OF "0" IF REMAINING VALUE IS NULL
0676: If fMakeNumeric="" Then
0677: fMakeNumeric="0"
0678: End if
0679: End Function
0680: '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
0681: Function fStandardizePercent(byVal Data)
0682: 'IF PERCENT NOT LESS THAN 1 THEN DIVIDE BY 100
0683: If cdbl(Data)>=1 Then
0684: fStandardizePercent=cdbl(Data)/100
0685: Else
0686: fStandardizePercent=Data
0687: End if
0688: End Function
0689: %>