cdatetime.cls

VB 加密----------能够加密解密控件

    If Value < -MAX_MILLISECONDS Or Value > MAX_MILLISECONDS Then _
        Throw New ArgumentOutOfRangeException
    
    Set AddMilliseconds = cDateTime.FromMilliseconds(mMilliseconds + CCur(Value), mKind)
End Function

''
' Adds a specified number of days to the current date, returning a
' new cDateTime instance with the calcuated value.
'
' @param value The number of days to add.
' @return The new cDateTime containing the calculated value.
'
Public Function AddDays(ByVal Value As Double) As cDateTime
    Set AddDays = AddMilliseconds(Value * MILLISECONDS_PER_DAY)
End Function

''
' Adds a specified number of hours to the current date, returning a
' new cDateTime instance with the calcuated value.
'
' @param value The number of hours to add.
' @return The new cDateTime instance containing the calculated value.
'
Public Function AddHours(ByVal Value As Double) As cDateTime
    Set AddHours = AddMilliseconds(Value * MILLISECONDS_PER_HOUR)
End Function

''
' Adds a specified number of minutes to the current date, returning a
' new cDateTime instance with the calcuated value.
'
' @param value The number of minutes to add.
' @return The new cDateTime instance containing the calculated value.
'
Public Function AddMinutes(ByVal Value As Double) As cDateTime
    Set AddMinutes = AddMilliseconds(Value * MILLISECONDS_PER_MINUTE)
End Function

''
' Adds a specified number of months to the current date, returning a
' new cDateTime instance with the calcuated value.
'
' @param Months The number of months to be added.
' @return The new cDateTime instance containing the calculated value.
' @remarks If the new month does not have as many days in it as the
' original month, then the day is set to the last day of the new month
' if it exceeds the maximum number of days for the new month.
'
Public Function AddMonths(ByVal Months As Long) As cDateTime
    If Months < -120000 Or Months > 120000 Then _
        Throw Cor.NewArgumentOutOfRangeException("Months must be between -120000 and 120000 inclusively.", "Months", Months)
    
    If Months = 0 Then
        Set AddMonths = Me
        Exit Function
    End If
    
    Dim Year    As Long
    Dim Month   As Long
    Dim Day     As Long
    Call GetDateParts(Complete, Year, Month, Day)
    
    Dim yearsToAdd As Long
    Dim monthsToAdd As Long
    
    yearsToAdd = MathExt.DivRem(Months, MONTHS_PER_YEAR, monthsToAdd)
    
    Month = Month + monthsToAdd
    Year = Year + yearsToAdd
    Select Case Month
        Case Is < 1
            Month = Month + MONTHS_PER_YEAR
            Year = Year - 1
        Case Is > MONTHS_PER_YEAR
            Month = Month - MONTHS_PER_YEAR
            Year = Year + 1
    End Select
    
    Dim MaxDays As Long
    MaxDays = cDateTime.DaysInMonth(Year, Month)
    If Day > MaxDays Then Day = MaxDays
    Set AddMonths = cDateTime.FromMilliseconds(GetTotalDays(Year, Month, Day) * MILLISECONDS_PER_DAY + Modulus(mMilliseconds, MILLISECONDS_PER_DAY), mKind)
End Function

''
' Adds a specified number of seconds to the current date, returning a
' new cDateTime instance with the calcuated value.
'
' @param value The number of seconds to be added.
' @return The new cDateTime instance containing the calculated value.
'
Public Function AddSeconds(ByVal Value As Double) As cDateTime
    Set AddSeconds = AddMilliseconds(Value * MILLISECONDS_PER_SECOND)
End Function

''
' Adds a specified number of ticks to the current date, returning a
' new cDateTime instance with the calcuated value.
'
' @param value The number of ticks to be added.
' @return the new cDateTime instance containing the calcuated value.
'
Public Function AddTicks(ByRef Value As Variant) As cDateTime
    Dim DecimalValue As Variant
    DecimalValue = CDec(Value)
    
    If DecimalValue < CDec(0) Or DecimalValue > CDec(MAX_MILLISECONDS) * 10000 Then _
        Throw Cor.NewArgumentOutOfRangeException("Ticks is outside the valid range of values", "value", DecimalValue)
    
    Set AddTicks = cDateTime.FromMilliseconds(mMilliseconds + DecimalValue / 10000, mKind)
End Function

''
' Adds a specified number of years to the current date., returning a
' new cDateTime instance with the calcuated value.
'
' @param value The number of years to be added.
' @return The new cDateTime instance containing the calculated value.
'
Public Function AddYears(ByVal Value As Long) As cDateTime
    Set AddYears = AddMonths(Value * MONTHS_PER_YEAR)
End Function

''
' Compares this instance to a passed in cDateTime instance.
'
' @param value The cDateTime or Date value to compare against this instance.
' @return A value indicating the relation to the passed in value. Negative
' indicates this instance is less than the argument, zero indicates the two
' values are equal, and positive indicates this value is greater than the
' argument.
'
Public Function CompareTo(ByRef Value As Variant) As Long
    Dim ms As Currency
    
    Select Case VariantType(Value) And &HFF
        Case vbObject
            If Value Is Nothing Then
                CompareTo = 1
            Else
                Dim dt As cDateTime
                On Error GoTo errTrap
                Set dt = Value
                ms = dt.TotalMilliseconds
                If mMilliseconds < ms Then
                    CompareTo = -1
                ElseIf mMilliseconds > ms Then
                    CompareTo = 1
                End If
            End If
        Case vbDate
            ms = cDateTime.AscDateTime(Value).TotalMilliseconds
            If mMilliseconds < ms Then
                CompareTo = -1
            ElseIf mMilliseconds > ms Then
                CompareTo = 1
            End If
        Case vbNull, vbEmpty, vbError
            CompareTo = 1
        Case Else
            Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_DateRequired), "value")
    End Select
    Exit Function
    
errTrap:
    Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_DateRequired), "value")
End Function

''
' Converts the cDateTime to a FileTime representation, adjusting for timezone.
'
' @return The filetime representation of the cDateTime.
' @remarks FileTime values cannot be less than 1/1/1601 12:00:00AM.
'
Public Function ToFileTime() As Currency
    Dim ms As Currency
    ms = TimeZone.CurrentTimeZone.ToUniversalTime(Me).TotalMilliseconds
    If ms < FILETIME_MINIMUM Then _
        Throw Cor.NewArgumentOutOfRangeException("Cannot convert times less than 1/1/1601 12:00AM to filetime.", "ToFileTime", ToString)
    ToFileTime = ms - MILLISECONDS_TO_16011231
End Function

''
' Converts the cDateTime to a FileTime representation, ignoring the timezone offset.
'
' @return The filetime representation of the cDateTime.
' @remarks FileTime values cannot be less than 1/1/1601 12:00:00AM.
'
Public Function ToFileTimeUtc() As Currency
    If mMilliseconds < FILETIME_MINIMUM Then _
        Throw Cor.NewArgumentOutOfRangeException("Cannot convert times less than 1/1/1601 12:00AM to filetime.", "ToFileTimeUtc", ToString)
    ToFileTimeUtc = mMilliseconds - MILLISECONDS_TO_16011231
End Function

''
' Returns a cDateTime with the timezone offset applied to this instance.
'
' @return The cDateTime object with the timezone offset applied.
'
Public Function ToLocalTime() As cDateTime
    Set ToLocalTime = TimeZone.CurrentTimeZone.ToLocalTime(Me)
End Function

''
' Returns a cDateTime with the timezone offset removed from this instance.
'
' @return The cDateTime object with the timezone offset removed.
'
Public Function ToUniversalTime() As cDateTime
    Set ToUniversalTime = TimeZone.CurrentTimeZone.ToUniversalTime(Me)
End Function

''
' Returns a string representation of this object instance.
'
' @param Format The format inwhich the date should represent.
' @param provider A formatting provider to format the date.
' @return String representing this instance.
' @see DateTimeFormatInfo
'
Public Function ToString(Optional ByVal Format As String, Optional ByVal Provider As IFormatProvider) As String
    Dim Info As DateTimeFormatInfo
    If Not Provider Is Nothing Then Set Info = Provider.GetFormat("datetimeformatinfo")
    If Info Is Nothing Then Set Info = CultureInfo.CurrentCulture.DateTimeFormat
    ToString = Info.Format(Me, Format)
End Function

''
' Returns the date formatted to the current cultures long date pattern.
'
' @return Long date pattern formatted string.
'
Public Function ToLongDateString() As String
    ToLongDateString = DateTimeFormatInfo.CurrentInfo.Format(Me, "D")
End Function

''
' Returns the date formatted to the current cultures short date pattern.
'
' @return Short date pattern formatted string.
'
Public Function ToShortDateString() As String
    ToShortDateString = DateTimeFormatInfo.CurrentInfo.Format(Me, "d")
End Function

''
' Returns the time formatted to the current cultures long time pattern.
'
' @return Long time pattern formatted string.
'
Public Function ToLongTimeString() As String
    ToLongTimeString = DateTimeFormatInfo.CurrentInfo.Format(Me, "T")
End Function

''
' Returns the time formatted to the current cultures short time pattern.
'
' @return Short time pattern formatted string.
'
Public Function ToShortTimeString() As String
    ToShortTimeString = DateTimeFormatInfo.CurrentInfo.Format(Me, "t")
End Function

''
' Returns a 64-bit representation of the time and kind.
'
' @return 64-bit representation of the cDateTime
' @remarks The upper 2 bits are used to represent the DateTimeKind
' of the object, the lower 62-bits are used to represent the 100-nanosecond
' segmented time.
'
Public Function ToBinary() As Currency
    ToBinary = mMilliseconds
    If mKind = LocalKind Then
        Dim ts As TimeSpan
        Set ts = TimeZone.CurrentTimeZone.GetUtcOffset(Me)
        ToBinary = ToBinary - ts.TotalMilliseconds
    End If
    MemByte(VarPtr(ToBinary) + 7) = MemByte(VarPtr(ToBinary) + 7) Or (mKind * &H40)
End Function

''
' Returns a boolean indicating if the value and this object
' instance are the same date.
'
' @param value The value to compare equality to.
' @return Boolean indicating equality.
'
Public Function Equals(ByRef Value As Variant) As Boolean
    Select Case VarType(Value)
        Case vbObject
            If Value Is Nothing Then Exit Function
            If TypeOf Value Is cDateTime Then
                Dim dt As cDateTime
                Set dt = Value
                Equals = (mMilliseconds = dt.TotalMilliseconds)
            End If
        Case vbDate
            Equals = (mMilliseconds = cDateTime.AscDateTime(Value).TotalMilliseconds)
    End Select
End Function

''
' Subtracts either a cDateTime instance or a TimeSpan instance from this
' cDateTime instance.
'
' @param value A cDateTime or TimeSpan object to subtract from this instance.