Subversion Repositories DevTools

<%
'=============================================================
'//
'//                  Validation Control
'//
'=============================================================
%>
<%
Class ValidationControl

   Private maRules()
   Private mobjFieldMap
   Private mobjErrorMsg
   Private mobjAltVal

   Private InxFieldName
   Private InxIsRequired
   Private InxIsNumeric
   Private InxMinNumericValue
   Private InxMaxNumericValue
   Private InxIsDate
   Private InxStartDate
   Private InxEndDate
   Private InxMinStringLength
   Private InxMaxStringLength
   Private InxRegExp
   Private InxRegExpDescription
   Private InxIsName

   Private mNumOfRules
   Private mLastRuleInx

   Private bIsFormValid
   Private bIsValidated
   Private bIsPostBack
   Private bHiddenTagPlanted

   Private sPostBackTagName
   Private sBULET


   Public Property Get IsPostBack ()
      IsPostBack = bIsPostBack
   End Property

   Public Property Get IsValidOnPostBack
      If bIsValidated Then
         IsValidOnPostBack = bIsFormValid
      Else
         IsValidOnPostBack = ValidateForm()
      End If

   End Property

   '-----------------------------------------------------------------------------------------------------------------
   Public Function GetValue ( sFieldName, altValue )
      If NOT bIsPostBack Then
         GetValue = altValue
      Else
         GetValue = Request(sFieldName)
      End If

      mobjAltVal.Item ( sFieldName ) = GetValue
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Public Sub SetValue ( sFieldName, altValue )
      If NOT bIsPostBack Then
         mobjAltVal.Item ( sFieldName ) = altValue
      Else
         mobjAltVal.Item ( sFieldName ) = Request(sFieldName)
      End If

   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Public Sub SetValueForced ( sFieldName, value )
      mobjAltVal.Item ( sFieldName ) = value

   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Private Function RequestValue( sFieldName )
      If NOT bIsPostBack Then
         RequestValue = mobjAltVal.Item ( sFieldName )
      Else
         If Request(sFieldName) <> "" Then
            RequestValue = Request(sFieldName)
         Else
            RequestValue = mobjAltVal.Item ( sFieldName )
         End If
      End If

   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Public Function IsTicked( sFieldName, nParId, altValue )
      Dim sParList

      nParId     = ","&  Replace(nParId, " ", "") &","
      sParList = ","&  Replace( Request(sFieldName), " ", "") &","

      If NOT bIsPostBack Then
         IsTicked = (NOT IsNull(altValue))  OR  (altValue <> "")

      Else
         If InStr( sParList, nParId ) > 0 Then
            IsTicked = TRUE
         Else
            IsTicked = FALSE
         End If

      End If

   End Function

   '-----------------------------------------------------------------------------------------------------------------
   Public Function AddPostBack ()
      '--- Plant Hidden Tag
      If NOT bHiddenTagPlanted Then
         ' This tag is used by this class to know if the form is posted back
         Response.write "<input type='hidden' name='"& sPostBackTagName &"' value='true'>"
         bHiddenTagPlanted = TRUE
      End If
   End Function

   '-----------------------------------------------------------------------------------------------------------------
   Public Function Validate ( sFieldName )

      '--- Plant Hidden Tag
      AddPostBack()

      Call ValidateField ( RequestValue(sFieldName), mobjFieldMap.Item ( Cstr( sFieldName  ) ) )

      Validate = GetErrorMsg ( sFieldName )

   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidateForm()
      Dim i, FieldValue, nLastRowInx
      mobjErrorMsg.RemoveAll   ' Clean Error Messages

      nLastRowInx = LastRowInx ()

      For i = 0 To nLastRowInx
         FieldValue = RequestValue( maRules( InxFieldName, i ) )

         Call ValidateField ( FieldValue, i )

      Next

      ' --- Finally, set the Form state of validity
      If mobjErrorMsg.Count > 0 Then
         bIsFormValid = FALSE
      Else
         bIsFormValid = TRUE
      End If


      bIsValidated = TRUE
      ValidateForm = bIsFormValid

   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Sub ValidateField ( FieldValue, i )

      If (i = "") OR (IsNull(i)) Then
         Err.Raise 8, "Cannot Find Field Name.", "Make sure you have correct filed names listed for validation."
         Exit Sub
      End If

      If mobjErrorMsg.Exists ( CStr( maRules( InxFieldName, i ) ) ) Then mobjErrorMsg.Remove ( CStr( maRules( InxFieldName, i ) ) )   ' Clean this field Error Messages

      ' RULE is_Required
      If NOT ValidForIsRequired ( FieldValue, i ) Then
         Call AddErrorMessage ( i, "Required." )

      Else

         If FieldValue <> "" Then

            ' --- RULE is_Number ---
            If NOT ValidForIsNumeric ( FieldValue, i ) Then
               Call AddErrorMessage ( i, "Must be a number." )
            Else

               If maRules( InxIsNumeric, i ) = enumDB_YES Then  ' Continue if field is a Number
                  ' --- RULE min_Numeric_value ---
                  If NOT ValidForMinNumericValue ( FieldValue, i ) Then
                     Call AddErrorMessage ( i, "Must be minimum "& maRules( InxMinNumericValue, i ) &"." )
                  End If

                  ' --- RULE max_Numeric_value ---
                  If NOT ValidForMaxNumericValue ( FieldValue, i ) Then
                     Call AddErrorMessage ( i, "Must be maximum "& maRules( InxMaxNumericValue, i ) &"." )
                  End If
               End If

            End If


            ' --- RULE is_Date ---
            If NOT ValidForIsDate ( FieldValue, i ) Then
               Call AddErrorMessage ( i, "Must be a date." )
            Else

               If maRules( InxIsDate, i ) = enumDB_YES Then  ' Continue if field is a Date
                  ' --- RULE start_Date ---
                  If NOT ValidForStartDate ( FieldValue, i ) Then
                     Call AddErrorMessage ( i, "Cannot be before "& maRules( InxStartDate, i ) &"." )
                  End If

                  ' --- RULE end_Date ---
                  If NOT ValidForEndDate ( FieldValue, i ) Then
                     Call AddErrorMessage ( i, "Cannot be after "& maRules( InxStartDate, i ) &"." )
                  End If

               End If

            End If


            ' --- RULE min_String_Length ---
            If NOT ValidForMinStringLength ( FieldValue, i ) Then
               Call AddErrorMessage ( i, "Must be at least "& maRules( InxMinStringLength, i ) &" character(s) long." )
            End If

            ' --- RULE min_String_Length ---
            If NOT ValidForMaxStringLength ( FieldValue, i ) Then
               Call AddErrorMessage ( i, "Can be maximum "& maRules( InxMaxStringLength, i ) &" character(s) long." )
            End If


            ' --- RULE Regular Expression ---
            If NOT ValidForRegExp ( FieldValue, i ) Then
               Call AddErrorMessage ( i, maRules( InxRegExpDescription, i ) )
            End If

            ' -- RULE for Name
            Call ValidValidForName ( FieldValue, i)

         End If


      End If
   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForIsRequired ( fieldValue, rowId )
      ValidForIsRequired = FALSE
      If maRules( InxIsRequired, rowId ) = enumDB_YES Then
         '/* Check if empty */
         If fieldValue <> "" Then

            '/* Check for spaces */
            If Len( Replace(fieldValue, " ", "") ) > 0 Then   ValidForIsRequired = TRUE

         End If

      Else
         ValidForIsRequired = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForRegExp ( fieldValue, rowId )
      Dim objRegEx

      ValidForRegExp = FALSE
      If IsNull( maRules( InxRegExp, rowId ) ) OR (maRules( InxRegExp, rowId ) = "") Then
         ValidForRegExp = TRUE
      Else
         Set objRegEx = New RegExp

         objRegEx.Global = False      ' Only find first match. This is enough to fail the validation
         objRegEx.IgnoreCase = False   ' Follow match pattern exactly.
          objRegEx.Pattern = maRules( InxRegExp, rowId )       ' Set the pattern to match

         ' Now test the pattern match.
         If objRegEx.Test( fieldValue ) Then
            ValidForRegExp = TRUE
         End If
         'Err.Raise 8, "Just a Test", "I got here4." & maRules( InxRegExp, rowId ) & ":" & fieldValue & "::" & ValidForRegExp  

         Set objRegEx = Nothing
      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForIsNumeric ( fieldValue, rowId )
      ValidForIsNumeric = FALSE
      If maRules( InxIsNumeric, rowId ) = enumDB_YES Then
         If IsNumeric( fieldValue ) Then ValidForIsNumeric = TRUE

      Else
         ValidForIsNumeric = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForMinNumericValue ( fieldValue, rowId )
      ValidForMinNumericValue = FALSE
      If IsNull( maRules( InxMinNumericValue, rowId ) ) OR (maRules( InxMinNumericValue, rowId ) = "") Then
         ValidForMinNumericValue = TRUE
      Else
         If CDbl(fieldValue) >= CDbl(maRules( InxMinNumericValue, rowId )) Then   ValidForMinNumericValue = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForMaxNumericValue ( fieldValue, rowId )
      ValidForMaxNumericValue = FALSE
      If IsNull( maRules( InxMaxNumericValue, rowId ) ) OR (maRules( InxMaxNumericValue, rowId ) = "") Then
         ValidForMaxNumericValue = TRUE
      Else
         If CDbl(fieldValue) <= CDbl(maRules( InxMaxNumericValue, rowId )) Then   ValidForMaxNumericValue = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForIsDate ( fieldValue, rowId )
      ValidForIsDate = FALSE
      If maRules( InxIsDate, rowId ) = enumDB_YES Then
         If IsDate( fieldValue ) Then ValidForIsDate = TRUE

      Else
         ValidForIsDate = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForStartDate ( fieldValue, rowId )
      ValidForStartDate = FALSE
      If IsNull( maRules( InxStartDate, rowId ) ) OR (maRules( InxStartDate, rowId ) = "") Then
         ValidForStartDate = TRUE
      Else
         If CDate(fieldValue) >= CDate(maRules( InxStartDate, rowId )) Then   ValidForStartDate = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForEndDate ( fieldValue, rowId )
      ValidForEndDate = FALSE
      If IsNull( maRules( InxEndDate, rowId ) ) OR (maRules( InxEndDate, rowId ) = "") Then
         ValidForEndDate = TRUE
      Else
         If CDate(fieldValue) <= CDate(maRules( InxStartDate, rowId )) Then   ValidForEndDate = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForMinStringLength ( fieldValue, rowId )
      ValidForMinStringLength = FALSE
      If IsNull( maRules( InxMinStringLength, rowId ) ) OR (maRules( InxMinStringLength, rowId ) = "") Then
         ValidForMinStringLength = TRUE
      Else
         If CInt(Len(fieldValue)) >= CInt(maRules( InxMinStringLength, rowId )) Then   ValidForMinStringLength = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidForMaxStringLength ( fieldValue, rowId )
      ValidForMaxStringLength = FALSE

      If IsNull( maRules( InxMaxStringLength, rowId ) ) OR (maRules( InxMaxStringLength, rowId ) = "") Then
         ValidForMaxStringLength = TRUE
      Else
         If CInt(Len(fieldValue)) <= CInt(maRules( InxMaxStringLength, rowId )) Then   ValidForMaxStringLength = TRUE

      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ValidValidForName ( fieldValue, rowId )
      ValidValidForName = TRUE
      If maRules( InxIsName, rowId ) = enumDB_YES Then
        Dim myRegExp, FoundMatch
        Set myRegExp = New RegExp
        myRegExp.Pattern = "^\s"
        If myRegExp.Test(fieldValue) Then
            Call AddErrorMessage ( rowId, "Leading Space" )
            ValidValidForName = FALSE
        Else
            myRegExp.Pattern = "\s$"
            If myRegExp.Test(fieldValue) Then
                Call AddErrorMessage ( rowId, "Trailing Space" )
                ValidValidForName = FALSE
            End If
        End If
      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Sub AddErrorMessage ( rowId, sErrMsg )
      mobjErrorMsg.Item (Cstr( maRules( InxFieldName, rowId ) )) = _
         mobjErrorMsg.Item (Cstr( maRules( InxFieldName, rowId ) )) &_
         "<tr>"&_
         sBULET  &"<td class='val_err'>"&  sErrMsg  &"</td>"&_
         "</tr>"& VBNewLine
   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Private Function LastRowInx ()
       LastRowInx = UBound ( maRules, 2 )
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function GetErrorMsg ( sFieldName )
      Dim msg
      msg = mobjErrorMsg.Item (CStr(sFieldName))
      If msg <> "" Then
         GetErrorMsg = _
         "<table width='100%'  border='0' cellspacing='2' cellpadding='0'>"& VBNewLine &_
         msg & VBNewLine &_
         "<tr><td width='1'>"& SPACER &"</td><td width='1'>"& SPACER &"</td><td width='100%'>"& SPACER &"</td></tr>"& VBNewLine &_
         "</table>"
      Else
         GetErrorMsg = NULL
      End If
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Function ParseParams ( sParams )
      Dim paramArr, i

      paramArr = Split ( sParams, "'" )      ' Expected Params value:  id='field_name' IsRequired='N' param2='val' ...

      ' Store Validation changes/rules in array
      For i = 0 To UBound( paramArr )-1 Step 2
         Call UpdateRow ( paramArr(1), GetColumnInx ( paramArr(i) ), paramArr(i+1) )
      Next

      ParseParams = paramArr(1)   ' id must be first param

   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Public Sub UpdateRules ( sParams )
      ParseParams ( sParams )

   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Private Sub UpdateRow ( sFieldName, sColumnInx, sColumnVal )
      Dim rowNum

      If mobjFieldMap.Exists (CStr(sFieldName)) Then
         rowNum = mobjFieldMap.Item ( Cstr( sFieldName  ) )

      Else
         rowNum = LastRowInx() + 1
         ReDim Preserve maRules( mNumOfRules, rowNum )

         mobjFieldMap.Add ( Cstr( sFieldName ) ), CStr( rowNum )

      End If

      maRules ( sColumnInx, rowNum ) = sColumnVal

   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Private Function GetColumnInx ( ByVal sParam )
      sParam = Trim( sParam )      ' Trim spaces
      sParam = Left( sParam, Len(sParam)-1 )   ' Remove trailing "="

      Select Case Trim( sParam )
         Case "id"
            GetColumnInx = InxFieldName
         Case Else
            GetColumnInx = Eval( "Inx"& Trim( sParam ) )

      End Select
   End Function
   '-----------------------------------------------------------------------------------------------------------------
   Private Sub Class_Initialize()
      '// Perform action on creation of object. e.g. Set myObj = New ThisClassName
      Set mobjFieldMap = CreateObject("Scripting.Dictionary")
      Set mobjErrorMsg = CreateObject("Scripting.Dictionary")
      Set mobjAltVal     = CreateObject("Scripting.Dictionary")

      sPostBackTagName = "VC_POST_BACK"


      bHiddenTagPlanted = FALSE
      bIsPostBack = FALSE      ' When true, form has been submitted and need postback validation
      bIsValidated = FALSE


      InxFieldName          = 0
      InxIsRequired         = 1
      InxIsNumeric          = 2
      InxMinNumericValue    = 3
      InxMaxNumericValue    = 4
      InxIsDate             = 5
      InxStartDate          = 6
      InxEndDate            = 7
      InxMinStringLength    = 8
      InxMaxStringLength    = 9
      InxRegExp             = 10
      InxRegExpDescription  = 11
      InxIsName             = 12
      mNumOfRules           = 13     ' Number of Rules that can be assigned to one field
      mLastRuleInx = mNumOfRules - 1

      ReDim maRules ( mNumOfRules, -1 )

      'sSESSION_SEPARATOR = "|SEPARATOR|"      ' Make sure it will never show in regexp field
                sBULET = "<td background='images/red_dot.gif'>"& SPACER &"</td>"&_
             "<td valign='top'><img src='icons/i_bulet_red.gif' width='4' height='4' hspace='3' vspace='4' border='0' align='absmiddle'></td>"


      '--- Check if Form is posted back
      If Request(sPostBackTagName) <> "" Then
         bIsPostBack = TRUE
      End If
   End Sub
   '-----------------------------------------------------------------------------------------------------------------
   Private Sub Class_Terminate()
      '// Perform action on object disposal. e.g. Set myObj = Nothing
      Set mobjFieldMap = Nothing
      Set mobjErrorMsg = Nothing
      Set mobjAltVal = Nothing

   End Sub
   '-----------------------------------------------------------------------------------------------------------------
End Class
%>