cdatetime.cls

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

' @return If subtracting a cDateTime object from this, then a TimeSpan
' representing the difference in time between the two is returned. If subtracting
' a TimeSpan object from this instance, then a new cDateTime with a difference
' of the TimeSpan obect from this instance is returned.
'
Public Function Subtract(ByRef Value As Variant) As Object
    Select Case VariantType(Value) And &HFF
        Case vbObject
            If TypeOf Value Is TimeSpan Then
                Dim ts As TimeSpan
                Set ts = Value
                Set Subtract = cDateTime.FromMilliseconds(mMilliseconds - ts.TotalMilliseconds, mKind)
            ElseIf TypeOf Value Is cDateTime Then
                Dim dt As cDateTime
                Set dt = Value
                Set Subtract = TimeSpan.FromMilliseconds(mMilliseconds - dt.TotalMilliseconds)
            Else
                Throw Cor.NewArgumentException("Date, cDateTime or TimeSpan object is required.", "value")
            End If
        Case vbDate
            Set Subtract = TimeSpan.FromMilliseconds(mMilliseconds - cDateTime.AscDateTime(Value).TotalMilliseconds)
        Case Else
            Throw Cor.NewArgumentException("Date, cDateTime or TimeSpan object is required.", "value")
    End Select
End Function

''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
'
Public Function GetHashCode() As Long
    With AsDLong(mMilliseconds)
        GetHashCode = .HiDWord Xor .LoDWord
    End With
End Function

''
' Determines if this instance is greater than another cDateTime object.
'
' @param dt The cDateTime object to compare against.
' @return Returns True if this object is greater than the dt object.
' @remarks This is provided for quick comparisions of two cDateTime objects.
'
Public Function GreaterThan(ByRef dt As cDateTime) As Boolean
    If dt Is Nothing Then
        GreaterThan = True
    Else
        GreaterThan = (mMilliseconds > dt.TotalMilliseconds)
    End If
End Function

''
' Determines if this instance is less than another cDateTime object.
'
' @param dt The cDateTime object to compare against.
' @return Returns True if this object is less than the dt object.
' @remarks This is provided for quick comprisons of two cDateTimeObjects.
'
Public Function LessThan(ByRef dt As cDateTime) As Boolean
    If dt Is Nothing Then Exit Function
    LessThan = (mMilliseconds < dt.TotalMilliseconds)
End Function

''
' Determines if this instance is greater than or equal to another cDateTime object.
'
' @param dt The cDateTime object to compare against.
' @return Returns True if this object is greater than or equal to the dt object.
' @remarks This is provided for quick comprisons of two cDateTimeObjects.
'
Public Function GreaterThanOrEqualTo(ByRef dt As cDateTime) As Boolean
    If dt Is Nothing Then
        GreaterThanOrEqualTo = True
    Else
        GreaterThanOrEqualTo = (mMilliseconds >= dt.TotalMilliseconds)
    End If
End Function

''
' Determines if this instance is less than or equal to another cDateTime object.
'
' @param dt The cDateTime object to compare against.
' @return Returns True if this object is less than or equal to the dt object.
' @remarks This is provided for quick comprisons of two cDateTimeObjects.
'
Public Function LessThanOrEqualTo(ByRef dt As cDateTime) As Boolean
    If dt Is Nothing Then Exit Function
    LessThanOrEqualTo = (mMilliseconds <= dt.TotalMilliseconds)
End Function

''
' Determines if this instance is equal to another cDateTime object.
'
' @param dt The cDateTime object to compare against.
' @return Returns True if this object is equal to the dt object.
' @remarks This is provided for quick comprisons of two cDateTimeObjects.
'
Public Function EqualTo(ByRef dt As cDateTime) As Boolean
    If dt Is Nothing Then Exit Function
    EqualTo = (mMilliseconds = dt.TotalMilliseconds)
End Function

''
' Determines if this instance is not equal to another cDateTime object.
'
' @param dt The cDateTime object to compare against.
' @return Returns True if this object is not equal to the dt object.
' @remarks This is provided for quick comprisons of two cDateTimeObjects.
'
Public Function NotEqualTo(ByRef dt As cDateTime) As Boolean
    If dt Is Nothing Then
        NotEqualTo = True
    Else
        NotEqualTo = (mMilliseconds <> dt.TotalMilliseconds)
    End If
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long, ByVal Hour As Long, ByVal Minute As Long, ByVal Second As Long, ByVal Millisecond As Long, ByVal Calendar As Calendar, ByVal Kind As DateTimeKind)
    If Calendar Is Nothing Then
        mMilliseconds = GetTotalDays(Year, Month, Day) * MILLISECONDS_PER_DAY + GetTotalMilliseconds(Hour, Minute, Second, Millisecond)
    Else
        mMilliseconds = Calendar.ToDateTime(Year, Month, Day, Hour, Minute, Second, Millisecond).TotalMilliseconds
    End If
    mKind = Kind
End Sub

Friend Sub InitFromMilliseconds(ByVal ms As Currency, ByVal Kind As DateTimeKind)
    If ms < 0@ Or ms > MAX_MILLISECONDS Then _
        Throw Cor.NewArgumentOutOfRangeException("Milliseconds must be between 0 and " & MAX_MILLISECONDS & " inclusively.", "ms", ms)
        
    mMilliseconds = ms
    mKind = Kind
End Sub

Friend Sub InitFromDate(ByVal d As Date, ByVal Kind As DateTimeKind)
    Dim Days As Currency
    
    If d < 0# Then
        Days = Fix(d * MILLISECONDS_PER_DAY - 0.5)
        Days = Days - Modulus(Days, MILLISECONDS_PER_DAY) * 2
    Else
        Days = Fix(d * MILLISECONDS_PER_DAY + 0.5)
    End If
    mMilliseconds = Days + MILLISECONDS_TO_18991231
    mKind = Kind
End Sub

Friend Sub InitFromFileTime(ByVal Time As Currency, ByVal Kind As DateTimeKind)
    If Time < 0@ Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "Time", Time)
    
    mMilliseconds = Time + MILLISECONDS_TO_16011231
    mKind = Kind
End Sub

Friend Sub InitFromBinary(ByVal Value As Currency)
    mMilliseconds = Value

    ' Get the address of the 8th byte in the 64-bit value.
    Dim PtrToHighByte As Long
    PtrToHighByte = VarPtr(mMilliseconds) + 7
    
    ' Get the value of the 8th byte in the 64-bit value.
    Dim HighByte As Long
    HighByte = MemByte(PtrToHighByte)
    
    ' Strip off the highest 2-bits of the 8th byte in the 64-bit value.
    MemByte(PtrToHighByte) = HighByte And &H3F
    
    ' Shift the upper 2 bits to the lowest 2 bits to represent the Kind.
    mKind = (HighByte And &HC0) \ &H40
    
    If mKind = LocalKind Then
        Dim ts As TimeSpan
        Set ts = TimeZone.CurrentTimeZone.GetUtcOffset(Me)
        mMilliseconds = mMilliseconds + ts.TotalMilliseconds
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub GetDateParts(ByVal DatePart As DatePartPrecision, Optional ByRef Year As Long, Optional ByRef Month As Long, Optional ByRef Day As Long, Optional ByRef DayOfYear As Long)
    Dim Days As Long
    Days = Int(mMilliseconds / MILLISECONDS_PER_DAY)
    
    Dim years400 As Long
    years400 = Days \ DAYS_PER_400_YEARS
    Days = Days - years400 * DAYS_PER_400_YEARS
    
    Dim years100 As Long
    years100 = Days \ DAYS_PER_100_YEARS
    If years100 = 4 Then years100 = 3   ' leap year
    Days = Days - years100 * DAYS_PER_100_YEARS
    
    Dim years4 As Long
    years4 = Days \ DAYS_PER_4_YEARS
    Days = Days - years4 * DAYS_PER_4_YEARS
    
    Dim Years As Long
    Years = Days \ 365
    If Years = 4 Then Years = 3 ' leap year
    
    ' Return the Year.
    Year = years400 * 400 + years100 * 100 + years4 * 4 + Years + 1
    If DatePart = YearPart Then Exit Sub
    
    Days = Days - Years * DAYS_PER_YEAR
    
    ' Return the DayOfYear
    DayOfYear = Days + 1
    If DatePart = DayOfTheYear Then Exit Sub
    
    ' Month will be set in the CalculateDays method.
    ' Day is set to the result of CalculateDays.
    If Years = 3 And (years100 = 3 Or years4 <> 24) Then
        Day = CalculateDay(Days, Month, DaysToMonthLeapYear) + 1
    Else
        Day = CalculateDay(Days, Month, DaysToMonth) + 1
    End If
End Sub

Private Function CalculateDay(ByVal Days As Long, ByRef Month As Long, ByRef Months() As Long) As Long
    Do While Months(Month) <= Days
        Month = Month + 1
    Loop
    CalculateDay = Days - Months(Month - 1)
End Function

Private Function GetTotalDays(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long) As Long
    If Year = 0 And Month = 0 And Day = 0 Then Exit Function
    If Year < 1 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_ValidValues), "Year", Year)
    If Month < 1 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_ValidValues), "Month", Month)
    If Day < 1 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_ValidValues), "Day", Day)
    
    Dim Days As Long
    If cDateTime.IsLeapYear(Year) Then
        Days = DaysToMonthLeapYear(Month - 1)
    Else
        Days = DaysToMonth(Month - 1)
    End If
    
    Year = Year - 1
    GetTotalDays = (Day - 1) + Days + 365 * Year + (Year \ 4) - ((Year \ 100) - (Year \ 400))
End Function

Private Function GetTotalMilliseconds(ByVal Hour As Long, ByVal Minute As Long, ByVal Second As Long, ByVal Millisecond As Long) As Currency
    GetTotalMilliseconds = Hour * MILLISECONDS_PER_HOUR + Minute * MILLISECONDS_PER_MINUTE + Second * MILLISECONDS_PER_SECOND + Millisecond
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_ReadProperties(PropBag As PropertyBag)
    With PropBag
        mMilliseconds = .ReadProperty(PROP_MILLISECONDS, DEF_MILLISECONDS)
        mKind = .ReadProperty(PROP_KIND, DEF_KIND)
    End With
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty(PROP_MILLISECONDS, mMilliseconds)
        Call .WriteProperty(PROP_KIND, mKind)
    End With
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IObject Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IObject_Equals(Value As Variant) As Boolean
    IObject_Equals = Equals(Value)
End Function

Private Function IObject_GetHashcode() As Long
    IObject_GetHashcode = GetHashCode
End Function

Private Function IObject_ToString() As String
    IObject_ToString = ToString
End Function

Private Function IComparable_CompareTo(Value As Variant) As Long
    IComparable_CompareTo = CompareTo(Value)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IFormattable Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IFormattable_ToString(ByVal Format As String, ByVal Provider As IFormatProvider) As String
    IFormattable_ToString = ToString(Format, Provider)
End Function