At the center of this strategy is an algorithm that can tell whether a date expression has a century in it. Listing 8-4 shows the CStrictDate class that uses this algorithm to test any expressions as they are assigned, rejecting those that fail its test. This class can be used in place of the Date data type to enforce a strict policy of Year 2000 compliance on all dates stored. The class will reject the assignment of a date expression where the century information is not present.
At the center of this class is the bPiIsStrictDate function, which performs a job similar to Visual Basic's IsDate function. In the case ofbPiIsStrictDate, an extra test is performed to make sure that the passed expression not only can be converted to a Date, but is also unambiguous.
Listing 8-4 The CStrictDate Class
'------------------------------------------------------
' This is an implementation of a Strict Date data type.
' In this class, only valid and unambiguous dates are
' stored. If an assignment is attempted using an
' ambiguous date expression such as '02/02/98,' this
' is rejected as if it were an invalid value.
'-------------------------------------------------------
Option Explicit
' This is where the date is actually stored.
' As all dates this defaults to '1899-12-30'.
Private m_dteInternalDate As Date
' This is the error that is raised if an attempt is
' made to assign an invalid date (as VB's Date does).
Private Const ERROR_TYPE_MISMATCH As Long = 13
Private Function bPiIsStrictDate(ByVal Expression As Variant) _
As Boolean
'-------------------------------------------------
' This function will return true if the passed
' date expression is a valid and unambiguous date.
' If the expression is either ambiguous or
' invalid, it will return false.
'-------------------------------------------------
Dim bIsDate As Boolean
' OK, VB can do the hard work. Can this value
' be converted to a date?
bIsDate = VBA.Information.IsDate(Expression)
' Additional check if the literal is a string.
' Is it an ambiguous date?
If bIsDate = True And VarType(Expression) = vbString Then
' Search for the year within the passed string literal.
If 0 = InStr(1, _
VBA.Conversion.CStr(Expression), _
VBA.DateTime.Year(VBA.Conversion.CDate(Expression)), _
vbTextCompare) Then
' We could not find the full 4-digit year in the
' passed literal; therefore the date is ambiguous
' and so we mark it as invalid.
bIsDate = False
End If
End If
' Return whether this is a valid date or not.
bPiIsStrictDate = bIsDate
End Function
Public Property Get DateValue() As Variant
' Return the date value stored internally.
DateValue = m_dteInternalDate
End Property
Public Property Let DateValue(ByVal Expression As Variant)
If bPiIsStrictDate(Expression) Then
' If the date expression does conform to our
' validation rules, store it.
m_dteInternalDate = VBA.Conversion.CDate(Expression)
Else
' Otherwise emulate VB and raise a standard error.
Err.Raise ERROR_TYPE_MISMATCH
End If
End Property
Public Property Get IsLeapYear() As Boolean
'------------------------------------------
' This read-only property indicates
' whether the stored Date value is in
' a leap year.
'------------------------------------------
IsLeapYear = 29 _
= VBA.DateTime.Day(VBA.DateTime.DateSerial( _
VBA.DateTime.Year(m_dteInternalDate), 2, 29))
End Property
|