Subversion Repositories DevTools

<%
'=============================================================
'//
'//                                             Validation Control
'//
'// version:            1.6
'//     last modified:  02-Sep-2004 12:11 by Sasha Vukovic
'=============================================================
%>
<%
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 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
        '-----------------------------------------------------------------------------------------------------------------
        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 Validate ( sFieldName )
                
                '--- 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
                
                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
                                
                                
                                
                        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 NOT objRegEx.Test( fieldValue ) Then
                                ValidForRegExp = TRUE
                        End If
                        
                        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 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
        '-----------------------------------------------------------------------------------------------------------------
        Public Sub LoadFieldRules ( aRows )
                ' Pass the full array row matching the columns of maRules()
                Dim nProperty, newArrayDim, numOfRows, rowNum
                
                numOfRows = UBound( aRows, 2 )
                
                
                For rowNum = 0 To numOfRows
                        ' Increase array by 1
                        newArrayDim = LastRowInx() + 1
                        ReDim Preserve maRules( mNumOfRules, newArrayDim )
                        
                        mobjFieldMap.Add ( Cstr( aRows ( InxFieldName, rowNum ) ) ), CStr( newArrayDim )
                        
                        For nProperty = 0 To mLastRuleInx
                                maRules ( nProperty, newArrayDim ) = aRows ( nProperty, rowNum )
                        Next
                        
                Next
                
                ' --- Validate Form ---
                'ValidateForm()
                
        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
        '-----------------------------------------------------------------------------------------------------------------
        Sub LoadValidationRules ( aFieldList, ByRef objOraDatabase )
                Dim rsQry, query
                
                query = _
                "   SELECT FIELD_NAME, "&_
                "                  IS_REQUIRED, "&_
                "                  IS_NUMERIC, "&_
                "                  MIN_NUMERIC_VALUE, "&_
                "                  MAX_NUMERIC_VALUE, "&_
                "                  IS_DATE, "&_
                "                  START_DATE, "&_
                "                  END_DATE, "&_
                "                  MIN_STRING_LENGTH, "&_
                "                  MAX_STRING_LENGTH, "&_
                "                  REGEXP, "&_
                "                  REGEXP_DESCRIPTION "&_
                "         FROM VALIDATION_RULES"&_
                "        WHERE field_name IN ( '"& Join( aFieldList, "','") &"' )"
                
                
                Set rsQry = objOraDatabase.DbCreateDynaset( query , 0 )
                If ((NOT rsQry.BOF) AND (NOT rsQry.EOF)) Then
                        Call LoadFieldRules ( rsQry.GetRows() )
                        
                End If
                
                rsQry.Close
                Set rsQry = Nothing
        End Sub
        '-----------------------------------------------------------------------------------------------------------------
        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
                mNumOfRules = 12        ' 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
%>