hijricalendar.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 = "HijriCalendar"
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: HijriCalendar
'

''
' Provides methods for manipulating Hijri dates.
'
' @remarks This is based on the Tabular version of the Islamic calendar,
' not the pure lunar version.
' @see HijriCalendarStatic
' @see Calendar
'
Option Explicit
Implements IObject
Implements Calendar

Private Const DEF_TWODIGITYEARMAX       As Long = 1451

' Number of Gregorian days to 7/18/622.
' This is 2 days after the start of the Hijri calendar to
' allow for the Hijri Adjustment to still fit in the window.
Private Const EPOCH As Long = 227013

' The Hijri calendar has a 30 year cycle with 11 of those years being leap years.
' The common year is 354 days, leap years are 355.
' (19 * 354) + (11 * 355) = 10631
Private Const DAYS_PER_30YEARS          As Long = 10631

' This is used similar to adding 0.5 to a value and taking the integer to
' round to the nearest whole integer.
' DAYS_PER_30YEARS + (((30 * 355) - (30 * 354))/2) = 10646
Private Const YEAR_ROUNDING_BIAS        As Long = 10646

' This is 4/3/9666 in fixed days, the maximum valid Hijri date.
Private Const MAX_FIXED_DAYS            As Long = 3530161
Private Const MAX_YEAR                  As Long = 9666
Private Const MAX_SHORTMONTH            As Long = 4
Private Const MAX_SHORTDAY              As Long = 3
Private Const MONTHS_PER_YEAR           As Long = 12

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 mHijriAdjustment    As Long
Private mTwoDigitYearMax    As Long
Private mMonthDays()        As Long



Public Property Get HijriAdjustment() As Long
    HijriAdjustment = mHijriAdjustment
End Property

Public Property Let HijriAdjustment(ByVal RHS As Long)
    If RHS < -2 Or RHS > 2 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Range, -2, 2), "HijriAdjustment", HijriAdjustment)
        
    mHijriAdjustment = RHS
End Property

Public Property Get Eras() As Long()
    Dim ret(0) As Long
    ret(0) = HijriCalendar.HijriEra
    Eras = ret
End Property

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

Public Property Let TwoDigitYearMax(ByVal RHS As Long)
    If RHS < 100 Or RHS > MAX_YEAR Then _
        Throw Cor.NewArgumentOutOfRangeException("Year must be between 100 and 9999 inclusively.", "TwoDigitYearMax", 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
    If Months < -120000 Or Months > 120000 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Range, -120000, 120000), "Months", Months)
    
    If Months = 0 Then
        Set AddMonths = cDateTime.GetcDateTime(Time)
        Exit Function
    End If
    
    Dim Year As Long
    Dim Month As Long
    Dim Day As Long
    Call GetDateParts(Time, Complete, Year, Month, Day)
    Month = Month + Months
    Year = Year + MathExt.DivRem(Month, MONTHS_PER_YEAR, Month)
    
    Dim MaxDays As Long
    MaxDays = GetDaysInMonth(Year, Month)
    If Day > MaxDays Then Day = MaxDays
    
    Dim FixedDays As Long
    FixedDays = GetFixedDaysFromParts(Year, Month, Day)
    
    Dim ms As Currency
    ms = cDateTime.GetcDateTime(Time).TotalMilliseconds
    Set AddMonths = cDateTime.FromMilliseconds(MILLISECONDS_PER_DAY * FixedDays + Modulus(ms, MILLISECONDS_PER_DAY))
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 = cDateTime.GetcDateTime(Time).AddDays(Weeks * 7)
End Function

Public Function AddYears(ByRef Time As Variant, ByVal Years As Long) As cDateTime
    Set AddYears = AddMonths(Time, Years * MONTHS_PER_YEAR)
End Function

Public Function GetDayOfMonth(ByRef Time As Variant) As Long
    Call GetDateParts(Time, DayPart, , , GetDayOfMonth)
End Function

Public Function GetDayOfYear(ByRef Time As Variant) As Long
    Call GetDateParts(Time, DayOfTheYear, , , , GetDayOfYear)
End Function

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

Public Function GetDaysInMonth(ByVal Year As Long, ByVal Month As Long, Optional ByRef Era As Variant) As Long
    Call VerifyEra(Era)
    Call VerifyYearMonth(Year, Month)
    
    If Month = 12 Then
        If IsLeapYear(Year) Then
            GetDaysInMonth = 30
        Else
            GetDaysInMonth = 29
        End If
    ElseIf (Month And 1) = 1 Then
        GetDaysInMonth = 30
    Else
        GetDaysInMonth = 29
    End If
End Function

Public Function GetDaysInYear(ByVal Year As Long, Optional ByRef Era As Variant) As Long
    If IsLeapYear(Year, Era) Then
        GetDaysInYear = 355
    Else
        GetDaysInYear = 354
    End If
End Function

Public Function GetEra(ByRef Time As Variant) As Long
    cDateTime.GetcDateTime Time
    GetEra = 1
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 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(Time, MonthPart, , GetMonth)
End Function

Public Function GetMonthsInYear(ByVal Year As Long, Optional ByRef Era As Variant) As Long
    Call VerifyEra(Era)
    Call VerifyYear(Year)
    
    If Year = MAX_YEAR Then
        GetMonthsInYear = MAX_SHORTMONTH
    Else
        GetMonthsInYear = MONTHS_PER_YEAR
    End If
End Function

Public Function GetSecond(ByRef Time As Variant) As Long
    GetSecond = cDateTime.GetcDateTime(Time).Second
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 GetYear(ByRef Time As Variant) As Long
    Call GetDateParts(Time, YearPart, GetYear)
End Function

Public Function IsLeapDay(ByVal Year As Long, ByVal Month As Long, ByVal Day As Long, Optional ByRef Era As Variant) As Boolean
    Dim MaxDays As Long
    
    MaxDays = Me.GetDaysInMonth(Year, Month)
    If Day < 1 Or Day > MaxDays Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Range, 1, MaxDays), "Day", Day)
        
    If Day = 30 And Month = 12 Then IsLeapDay = IsLeapYear(Year, Era)
End Function

Public Function IsLeapMonth(ByVal Year As Long, ByVal Month As Long, Optional ByRef Era As Variant) As Boolean
    Call VerifyEra(Era)
    Call VerifyYearMonth(Year, Month)
    
    IsLeapMonth = False
End Function

Public Function IsLeapYear(ByVal Year As Long, Optional ByRef Era As Variant) As Boolean
    Call VerifyEra(Era)
    Call VerifyYear(Year)
    
    Select Case Year Mod 30
        Case 2, 5, 7, 10, 13, 16, 18, 21, 24, 26, 29: IsLeapYear = True
    End Select
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)
    Call VerifyYearMonthDay(Year, Month, Day)
    
    Dim ms As Currency
    ms = GetFixedDaysFromParts(Year, Month, Day) * MILLISECONDS_PER_DAY
    
    If ms >= 0 Then
        Set ToDateTime = cDateTime.FromMilliseconds(ms + Hour * MILLISECONDS_PER_HOUR + Minute * MILLISECONDS_PER_MINUTE + Second * MILLISECONDS_PER_SECOND + Millisecond)
    Else
        Throw Cor.NewArgumentOutOfRangeException("Invalid Year, Month, or Day for this calendar")
    End If
End Function

Public Function ToFourDigitYear(ByVal Year As Long) As Long
    Dim y As Long