hebrewcalendar.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 1  'Persistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "HebrewCalendar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2005 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: HebrewCalendar
'

''
' Provides methods for manipulating Hebrew (Jewish) dates.
'
' @remarks Information about the Hebrew calendar was found at "http://astro.nmsu.edu/~lhuber/leaphist.html"
' and "http://www.geocities.com/Athens/1584/"
' @see HebrewCalendarStatic
' @see Calendar
'
Option Explicit
Implements IObject
Implements Calendar

Private Const PROP_TWODIGITYEARMAX As String = "TwoDigitYearMax"

' "http://listserv.brown.edu/archives/cgi-bin/wa?A2=ind0404d&L=conlang&F=&S=&P=19287"
' the Hebrew calendar epoch - that is, Tishri 1, 1 AM -
' corresponds to Monday, October 7, 3761 BC in the Julian calendar, which
' is September 7, 3761 BC in the Gregorian calendar, which is RD -1,373,427.
Private Const EPOCH As Long = -1373427

Private Const SECONDS_PER_MINUTE        As Long = 60
Private Const MINUTES_PER_HOUR          As Long = 60
Private Const HOURS_PER_DAY             As Long = 24

Private Const MILLISECONDS_PER_SECOND   As Currency = 1000@
Private Const MILLISECONDS_PER_MINUTE   As Currency = MILLISECONDS_PER_SECOND * SECONDS_PER_MINUTE
Private Const MILLISECONDS_PER_HOUR     As Currency = MILLISECONDS_PER_MINUTE * MINUTES_PER_HOUR
Private Const MILLISECONDS_PER_DAY      As Currency = MILLISECONDS_PER_HOUR * HOURS_PER_DAY

Private Const PARTS_PER_HOUR            As Long = 1080

Private Const MIN_MILLISECONDS          As Currency = 49914748800000@
Private Const MAX_MILLISECONDS          As Currency = 70678396799999@
Private Const MIN_HEBREWYEAR            As Long = 5343
Private Const MAX_HEBREWYEAR            As Long = 6000

Private mTwoDigitYearMax As Long



Public Property Get Eras() As Long()
    Dim ret(0) As Long
    ret(0) = HebrewCalendar.HebrewEra
    Eras = ret
End Property

Public Property Get TwoDigitYearMax() As Long
    TwoDigitYearMax = mTwoDigitYearMax
End Property

Public Property Let TwoDigitYearMax(ByVal RHS As Long)
    Call VerifyYear(RHS)
    mTwoDigitYearMax = RHS
End Property

Public Function AddDays(ByRef Time As Variant, ByVal Days As Long) As cDateTime
    Set AddDays = cDateTime.GetcDateTime(Time).AddDays(Days)
End Function

Public Function AddHours(ByRef Time As Variant, ByVal Hours As Long) As cDateTime
    Set AddHours = cDateTime.GetcDateTime(Time).AddHours(Hours)
End Function

Public Function AddMilliseconds(ByRef Time As Variant, ByVal Milliseconds As Double) As cDateTime
    Set AddMilliseconds = cDateTime.GetcDateTime(Time).AddMilliseconds(Milliseconds)
End Function

Public Function AddMinutes(ByRef Time As Variant, ByVal Minutes As Long) As cDateTime
    Set AddMinutes = cDateTime.GetcDateTime(Time).AddMinutes(Minutes)
End Function

Public Function AddMonths(ByRef Time As Variant, ByVal Months As Long) As cDateTime
    Dim Year As Long
    Dim Month As Long
    Dim Day As Long
    Dim TOD As Currency
    Dim ms As Currency
    
    If Months = 0 Then
        Set AddMonths = cDateTime.GetcDateTime(Time)
        Exit Function
    End If
    
    ms = cDateTime.GetcDateTime(Time).TotalMilliseconds
    TOD = Modulus(ms, MILLISECONDS_PER_DAY)
    Call GetDateParts(ms, Complete, Year, Month, Day)
    Month = ToDotNetMonth(Year, Month)
    
    If Months < 0 Then
        Do While Months < 0
            If Months + Month > 0 Then
                Month = Month + Months
                Exit Do
            Else
                Months = Months + Month
                Year = Year - 1
                Month = GetMonthsInYear(Year)
            End If
        Loop
    Else
        Dim i As Long
        Do While Months > 0
            i = GetMonthsInYear(Year)
            If Months + Month <= i Then
                Month = Month + Months
                Exit Do
            Else
                Months = Months - (i - Month + 1)
                Month = 1
                Year = Year + 1
            End If
        Loop
    End If
    
    Dim Max As Long
    Max = GetDaysInMonth(Year, Month)
    If Day > Max Then Day = Max
    
    Set AddMonths = ToDateTime(Year, Month, Day, 0, 0, 0, 0).AddMilliseconds(TOD)
End Function

Public Function AddSeconds(ByRef Time As Variant, ByVal Seconds As Long) As cDateTime
    Set AddSeconds = cDateTime.GetcDateTime(Time).AddSeconds(Seconds)
End Function

Public Function AddWeeks(ByRef Time As Variant, ByVal Weeks As Long) As cDateTime
    Set AddWeeks = AddDays(Time, Weeks * 7)
End Function

Public Function AddYears(ByRef Time As Variant, ByVal Years As Long) As cDateTime
    Dim Year As Long
    Dim Month As Long
    Dim Day As Long
    Dim ms As Currency
    
    ms = cDateTime.GetcDateTime(Time).TotalMilliseconds
    Call GetDateParts(ms, Complete, Year, Month, Day)
    Month = ToDotNetMonth(Year, Month)
    Year = Year + Years
    
    Set AddYears = ToDateTime(Year, Month, Day, 0, 0, 0, 0).AddMilliseconds(Modulus(ms, MILLISECONDS_PER_DAY))
End Function

Public Function GetEra(ByRef Time As Variant) As Long
    Call cDateTime.GetcDateTime(Time)   ' verifies we have a date.
    GetEra = HebrewCalendar.HebrewEra
End Function

Public Function GetHour(ByRef Time As Variant) As Long
    GetHour = cDateTime.GetcDateTime(Time).Hour
End Function

Public Function GetMilliseconds(ByRef Time As Variant) As Double
    GetMilliseconds = cDateTime.GetcDateTime(Time).Millisecond
End Function

Public Function GetSecond(ByRef Time As Variant) As Long
    GetSecond = cDateTime.GetcDateTime(Time).Second
End Function

Public Function GetMinute(ByRef Time As Variant) As Long
    GetMinute = cDateTime.GetcDateTime(Time).Minute
End Function

Public Function GetMonth(ByRef Time As Variant) As Long
    Call GetDateParts(cDateTime.GetcDateTime(Time).TotalMilliseconds, MonthPart, , GetMonth)
End Function

Public Function GetYear(ByRef Time As Variant) As Long
    Call GetDateParts(cDateTime.GetcDateTime(Time).TotalMilliseconds, YearPart, GetYear)
End Function

Public Function GetWeekOfYear(ByRef Time As Variant, ByVal Rule As CalendarWeekRule, ByVal FirstDayOfWeek As DayOfWeek) As Long
    GetWeekOfYear = InternalGetWeekOfYear(Time, Rule, FirstDayOfWeek, Me)
End Function

Public Function GetMonthsInYear(ByVal Year As Long, Optional ByRef Era As Variant) As Long
    If IsLeapYear(Year, Era) Then
        GetMonthsInYear = 13
    Else
        GetMonthsInYear = 12
    End If
End Function

Public Function GetDaysInMonth(ByVal Year As Long, ByVal Month As Long, Optional ByRef Era As Variant) As Long
    Call VerifyEra(Era)
    Call VerifyMonthYear(Month, Year)
    GetDaysInMonth = GetDaysInHebrewMonth(Year, ToHebrewMonth(Year, Month))
End Function

Public Function GetDaysInYear(ByVal Year As Long, Optional ByRef Era As Variant) As Long
    Call VerifyEra(Era)
    Call VerifyYear(Year)
    GetDaysInYear = GetFixedDaysFromParts(Year + 1, 7, 1) - GetFixedDaysFromParts(Year, 7, 1)
End Function

Public Function GetDayOfMonth(ByRef Time As Variant) As Long
    Call GetDateParts(cDateTime.GetcDateTime(Time).TotalMilliseconds, DayPart, , , GetDayOfMonth)
End Function

Public Function GetDayOfWeek(ByRef Time As Variant) As DayOfWeek
    GetDayOfWeek = cDateTime.GetcDateTime(Time).DayOfWeek
End Function

Public Function GetDayOfYear(ByRef Time As Variant) As Long
    Call GetDateParts(cDateTime.GetcDateTime(Time).TotalMilliseconds, DayOfTheYear, , , , GetDayOfYear)
End Function

Public Function IsLeapYear(ByVal Year As Long, Optional ByRef Era As Variant) As Boolean
    Call VerifyEra(Era)
    Call VerifyYear(Year)
    IsLeapYear = ((235 * Year - 234) Mod 19) > 11
End Function

Public Function IsLeapMonth(ByVal Year As Long, ByVal Month As Long, Optional ByRef Era As Variant) As Boolean
    Call VerifyEra(Era)
    Call VerifyMonthYear(Month, Year)
    If Month = 7 Then IsLeapMonth = IsLeapYear(Year)
End Function

Public Function IsLeapDay(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long, Optional ByRef Era As Variant) As Boolean
    If IsLeapYear(Year, Era) Then
        If Month = 6 Then IsLeapDay = (Day = 30)
    Else
        IsLeapDay = IsLeapMonth(Year, Month)
    End If
End Function

Public Function 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 ByRef Era As Variant) As cDateTime
    Call VerifyEra(Era)
    
    Dim d As Long
    d = GetDaysInMonth(Year, Month)
    
    If Day > d Then _
        Throw Cor.NewArgumentOutOfRangeException(cString.Format("Day must be between 1 and {0} for month {1}.", d, Month))
    
    Dim Days As Long
    Days = GetFixedDaysFromParts(Year, ToHebrewMonth(Year, Month), Day) - 1
    Set ToDateTime = cDateTime.FromMilliseconds(Days * MILLISECONDS_PER_DAY + Hour * MILLISECONDS_PER_HOUR + Minute * MILLISECONDS_PER_MINUTE + Second * MILLISECONDS_PER_SECOND + Millisecond)
End Function

Public Function ToFourDigitYear(ByVal Year As Long) As Long
    Select Case Year
        Case Is < 0
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "Year", Year)
            
        Case Is < 100
            Dim y As Long
            y = Year Mod 100
            ToFourDigitYear = (mTwoDigitYearMax \ 100) * 100 + y
            If y > mTwoDigitYearMax Mod 100 Then ToFourDigitYear = ToFourDigitYear - 100
            
        Case Is < MIN_HEBREWYEAR, Is > MAX_HEBREWYEAR
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Range, MIN_HEBREWYEAR, MAX_HEBREWYEAR), "Year", Year)
            
        Case Else
            ToFourDigitYear = Year
    End Select
End Function

''
' Returns a string representation of this object instance.
'
' @return String representing this instance.
Public Function ToString() As String
    ToString = Object.ToString(Me, App)
End Function

''
' Returns a boolean indicating if the value and this object
' instance are the same instance.
'
' @param value The value to compare equalit to.
' @return Boolean indicating equality.
Public Function Equals(ByRef Value As Variant) As Boolean
    Equals = Object.Equals(Me, Value)
End Function

''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
Public Function GetHashCode() As Long
    GetHashCode = ObjPtr(CUnk(Me))
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VerifyEra(ByRef Era As Variant)
    If IsMissing(Era) Then Exit Sub
    Select Case VarType(Era)
        Case vbLong, vbInteger, vbByte
            If Era < 0 Or Era > 1 Then Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidEraValue), "Era")
        Case Else
            Throw Cor.NewInvalidCastException("An integer value is required.")
    End Select
End Sub

Private Sub VerifyYear(ByVal Year As Long)
    If Year < MIN_HEBREWYEAR Or Year > MAX_HEBREWYEAR Then Throw Cor.NewArgumentOutOfRangeException("Hebrew year must be between 5343 and 6000.", "Year", Year)
End Sub

Private Sub VerifyMonthYear(ByVal Month As Long, ByVal Year As Long)
    Dim Max As Long
    
    If IsLeapYear(Year) Then