hebrewcalendar.cls

这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.

        Max = 13
    Else
        Max = 12
    End If
    
    If Month < 1 Or Month > Max Then _
        Throw Cor.NewArgumentOutOfRangeException(cString.Format("Month must be between 1 and {0} for year {1}.", Max, Year), "Month", Month)
End Sub

' this is based on the algorithm found at "http://www.funaba.org/en/calendar.html"
Private Function GetDaysToHebrewYear(ByVal Year As Long) As Long
    Dim Months As Long
    Dim Parts As Long
    Dim Hours As Long
    Dim Days As Long
    Dim TotalDays As Long
    Dim r As Long
    
    ' months before the specified year.
    Months = ((Year * 235 - 234) \ 19)
    
    ' get the day and parts of a day in the remaining month.
    Days = Months \ PARTS_PER_HOUR
    r = Months - (Days * PARTS_PER_HOUR)
    Parts = (r * 793) + 204
    
    ' calculate the total days
    Hours = (Months * 12) + 11 + (Days * 793) + (Parts \ PARTS_PER_HOUR)
    TotalDays = (Months * 29) + (Hours \ 24)
    
    ' cannot start a year on a Sunday, Wednesday or Friday.
    If (TotalDays + 1) * 3 Mod 7 < 3 Then TotalDays = TotalDays + 1
    GetDaysToHebrewYear = TotalDays
End Function

Private Function GetYearStartOffset(ByVal Year As Long) As Long
    Dim Year1 As Long
    Dim Year2 As Long
    
    Year1 = GetDaysToHebrewYear(Year)
    Year2 = GetDaysToHebrewYear(Year + 1)
    
    If Year2 - Year1 = 356 Then
        GetYearStartOffset = 2
    Else
        Year = GetDaysToHebrewYear(Year - 1)
        If Year1 - Year = 382 Then GetYearStartOffset = 1
    End If
End Function

''
' Calculations are performed using the month of 'Nissan' as the
' first month. This is the month that a Hebrew year actually
' increments by 1. The first month in Dot NET is Tishrei,
' so the calculated month needs to be adjusted to the Dot NET month.
'
' @param Year The year that contains the month to be mapped. The year
' may be a leap year which would alter the mapping.
' @param Month The month to be mapped from Hebrew to Dot NET alignment.
' @return The Dot NET version of the month.
'
Private Function ToDotNetMonth(ByVal Year As Long, ByVal HebrewMonth As Long) As Long
    If HebrewMonth >= 7 Then
        ToDotNetMonth = HebrewMonth - 6
    Else
        If IsLeapYear(Year) Then
            ToDotNetMonth = HebrewMonth + 7
        Else
            ToDotNetMonth = HebrewMonth + 6
        End If
    End If
End Function

''
' Calculations are performed using the month of 'Nissan' as the
' first month. This is the month that the Hebrew year actually
' increments by 1. When a function is called by a user and the
' month is a parameter, that month is aligned to the Dot NET version
' of the months and needs to be mapped to the Hebrew version to be
' used correctly in calculations.
'
' @param Year The year that contains the month to be mapped. The year
' may be a leap year which would alter the mapping.
' @param Month The month to be mapped from Dot NET to Hebrew alignment.
' @return The Hebrew version of the month.
'
Private Function ToHebrewMonth(ByVal Year As Long, ByVal Month As Long) As Long
    If Month < 7 Then
        ToHebrewMonth = Month + 6
    Else
        If IsLeapYear(Year) Then
            If Month = 7 Then
                ToHebrewMonth = Month + 6
            Else
                ToHebrewMonth = Month - 7
            End If
        Else
            ToHebrewMonth = Month - 6
        End If
    End If
End Function

Private Function GetDaysInHebrewMonth(ByVal Year As Long, ByVal Month As Long) As Long
    GetDaysInHebrewMonth = 30
    Select Case Month
        Case 2, 4, 6, 10, 13:   GetDaysInHebrewMonth = 29
        Case 8:                 If GetDaysInYear(Year) Mod 10 <> 5 Then GetDaysInHebrewMonth = 29
        Case 9:                 If GetDaysInYear(Year) Mod 10 = 3 Then GetDaysInHebrewMonth = 29
        Case 12:                If Not IsLeapYear(Year) Then GetDaysInHebrewMonth = 29
    End Select
End Function

Private Sub GetDateParts(ByVal ms As Currency, 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 FixedDays As Long
    
    If ms < MIN_MILLISECONDS Or ms > MAX_MILLISECONDS Then _
        Throw Cor.NewArgumentOutOfRangeException("The Hebrew calendar only supports the years 5343 to 6000 (1582 to 2240 in Gregorian).")
    
    FixedDays = Int(ms / MILLISECONDS_PER_DAY) + 1
    
    Year = Int((FixedDays - EPOCH) / 365.246822205978)  ' this is an approximation
    Do While FixedDays >= GetFixedDaysFromParts(Year, 7, 1): Year = Year + 1: Loop
    Year = Year - 1
    
    If DatePart = YearPart Then Exit Sub
    
    If FixedDays < GetFixedDaysFromParts(Year, 1, 1) Then
        Month = 7
    Else
        Month = 1
    End If
    
    Do While FixedDays > GetFixedDaysFromParts(Year, Month, GetDaysInHebrewMonth(Year, Month)): Month = Month + 1: Loop
    If DatePart = MonthPart Then
        Month = ToDotNetMonth(Year, Month)
        Exit Sub
    End If
    
    Day = FixedDays - GetFixedDaysFromParts(Year, Month, 1) + 1
    If DatePart = DayPart Then Exit Sub
    
    DayOfYear = FixedDays - GetFixedDaysFromParts(Year, 7, 1) + 1
End Sub

Private Function GetFixedDays(ByRef Time As Variant) As Long
    Dim dt As cDateTime
    Set dt = cDateTime.GetcDateTime(Time)
    GetFixedDays = Int(dt.TotalMilliseconds / MILLISECONDS_PER_DAY) + 1
End Function

Private Function GetFixedDaysFromParts(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long) As Long
    Dim i As Long
    Dim ret As Long
    Dim Max As Long
    
    ret = EPOCH - 1 + GetDaysToHebrewYear(Year) + GetYearStartOffset(Year)
    
    If Month < 7 Then
        For i = 1 To Month - 1
            ret = ret + GetDaysInHebrewMonth(Year, i)
        Next i
        Max = GetMonthsInYear(Year)
    Else
        Max = Month - 1
    End If
    
    For i = 7 To Max
        ret = ret + GetDaysInHebrewMonth(Year, i)
    Next i
    
    GetFixedDaysFromParts = ret + Day
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_InitProperties()
    mTwoDigitYearMax = GetCalendarLong(CAL_HEBREW, CAL_ITWODIGITYEARMAX)
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag)
    mTwoDigitYearMax = PropBag.ReadProperty(PROP_TWODIGITYEARMAX)
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty PROP_TWODIGITYEARMAX, mTwoDigitYearMax
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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Calendar Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function Calendar_AddDays(Time As Variant, ByVal Days As Long) As cDateTime
    Set Calendar_AddDays = AddDays(Time, Days)
End Function

Private Function Calendar_AddHours(Time As Variant, ByVal Hours As Long) As cDateTime
    Set Calendar_AddHours = AddHours(Time, Hours)
End Function

Private Function Calendar_AddMilliseconds(Time As Variant, ByVal Milliseconds As Double) As cDateTime
    Set Calendar_AddMilliseconds = AddMilliseconds(Time, Milliseconds)
End Function

Private Function Calendar_AddMinutes(Time As Variant, ByVal Minutes As Long) As cDateTime
    Set Calendar_AddMinutes = AddMinutes(Time, Minutes)
End Function

Private Function Calendar_AddMonths(Time As Variant, ByVal Months As Long) As cDateTime
    Set Calendar_AddMonths = AddMonths(Time, Months)
End Function

Private Function Calendar_AddSeconds(Time As Variant, ByVal Seconds As Long) As cDateTime
    Set Calendar_AddSeconds = AddSeconds(Time, Seconds)
End Function

Private Function Calendar_AddWeeks(Time As Variant, ByVal Weeks As Long) As cDateTime
    Set Calendar_AddWeeks = AddWeeks(Time, Weeks)
End Function

Private Function Calendar_AddYears(Time As Variant, ByVal Years As Long) As cDateTime
    Set Calendar_AddYears = AddYears(Time, Years)
End Function

Private Function Calendar_Equals(Value As Variant) As Boolean
    Calendar_Equals = Equals(Value)
End Function

Private Property Get Calendar_Eras() As Long()
    Calendar_Eras = Eras
End Property

Private Function Calendar_GetDayOfMonth(Time As Variant) As Long
    Calendar_GetDayOfMonth = GetDayOfMonth(Time)
End Function

Private Function Calendar_GetDayOfWeek(Time As Variant) As DayOfWeek
    Calendar_GetDayOfWeek = GetDayOfWeek(Time)
End Function

Private Function Calendar_GetDayOfYear(Time As Variant) As Long
    Calendar_GetDayOfYear = GetDayOfYear(Time)
End Function

Private Function Calendar_GetDaysInMonth(ByVal Year As Long, ByVal Month As Long, Optional Era As Variant) As Long
    Calendar_GetDaysInMonth = GetDaysInMonth(Year, Month, Era)
End Function

Private Function Calendar_GetDaysInYear(ByVal Year As Long, Optional Era As Variant) As Long
    Calendar_GetDaysInYear = GetDaysInYear(Year, Era)
End Function

Private Function Calendar_GetEra(Time As Variant) As Long
    Calendar_GetEra = GetEra(Time)
End Function

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

Private Function Calendar_GetHour(Time As Variant) As Long
    Calendar_GetHour = GetHour(Time)
End Function

Private Function Calendar_GetMilliseconds(Time As Variant) As Double
    Calendar_GetMilliseconds = GetMilliseconds(Time)
End Function

Private Function Calendar_GetMinute(Time As Variant) As Long
    Calendar_GetMinute = GetMinute(Time)
End Function

Private Function Calendar_GetMonth(Time As Variant) As Long
    Calendar_GetMonth = GetMonth(Time)
End Function

Private Function Calendar_GetMonthsInYear(ByVal Year As Long, Optional Era As Variant) As Long
    Calendar_GetMonthsInYear = GetMonthsInYear(Year, Era)
End Function

Private Function Calendar_GetSecond(Time As Variant) As Long
    Calendar_GetSecond = GetSecond(Time)
End Function

Private Function Calendar_GetWeekOfYear(Time As Variant, ByVal Rule As CalendarWeekRule, ByVal FirstDayOfWeek As DayOfWeek) As Long
    Calendar_GetWeekOfYear = GetWeekOfYear(Time, Rule, FirstDayOfWeek)
End Function

Private Function Calendar_GetYear(Time As Variant) As Long
    Calendar_GetYear = GetYear(Time)
End Function

Private Function Calendar_IsLeapDay(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long, Optional Era As Variant) As Boolean
    Calendar_IsLeapDay = IsLeapDay(Year, Month, Day, Era)
End Function

Private Function Calendar_IsLeapMonth(ByVal Year As Long, ByVal Month As Long, Optional Era As Variant) As Boolean
    Calendar_IsLeapMonth = IsLeapMonth(Year, Month, Era)
End Function

Private Function Calendar_IsLeapYear(ByVal Year As Long, Optional Era As Variant) As Boolean
    Calendar_IsLeapYear = IsLeapYear(Year, Era)
End Function

Private Function Calendar_ToDateTime(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, Optional Era As Variant) As cDateTime
    Set Calendar_ToDateTime = ToDateTime(Year, Month, Day, Hour, Minute, Second, Millisecond, Era)
End Function

Private Function Calendar_ToFourDigitYear(ByVal Year As Long) As Long
    Calendar_ToFourDigitYear = ToFourDigitYear(Year)
End Function

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

Private Property Let Calendar_TwoDigitYearMax(ByVal RHS As Long)
    TwoDigitYearMax = RHS
End Property

Private Property Get Calendar_TwoDigitYearMax() As Long
    Calendar_TwoDigitYearMax = TwoDigitYearMax
End Property