datetimeformatinfo.cls

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

    Else
        If VarType(Format) = vbString Then Format = Asc(Format)
        GetAllDateTimePatterns = GetSpecificDateTimePattern(Format)
    End If
End Function

''
' Returns the full name for the day of the week.
'
' @param dow The day of the week to get the name for.
' @return The name for the day of the week.
'
Public Function GetDayName(ByVal dow As DayOfWeek) As String
    Call VerifyLoaded
    GetDayName = mProps.DayNames(dow)
End Function

''
' Returns the numeric era value based on the name provided.
'
' @param eraName The name of the era to retrieve the numeric value for.
' @return The numeric value for the era.
' @remarks This method is not fully implemented. It will return 1
' for all era names and cultures.
'
Public Function GetEra(ByRef eraName As String) As Long
    Call VerifyLoaded
    ' need to update the culture table to handle multiple eras.
    GetEra = 1
End Function

''
' Returns the full name of the specified.
'
' @param Era The numerical era in which to retrieve the name for.
' @return The full era name.
' @remarks This method is not fully implements. It will return
' 'A.D.' for all numbers and cultures.
'
Public Function GetEraName(ByVal Era As Long) As String
    Call VerifyLoaded
    ' need to update the culture table to handle multiple eras.
    GetEraName = "A.D." ' mProps.Era
End Function

''
' Returns a format provider for the specified format type.
'
' @param FormatType The name of the formatting type requested.
' @return The formatting provider, or Nothing is none is available.
'
Public Function GetFormat(ByRef FormatType As String) As Object
    If LCase$(FormatType) = "datetimeformatinfo" Then
        Set GetFormat = Me
    End If
End Function

''
' Returns the full name of the specified month.
'
' @param Month The month to retrieve the name for.
' @return The full name of the month.
' @remarks The valid range is 1 to 13.
'
Public Function GetMonthName(ByVal Month As Long) As String
    Call VerifyLoaded
    
    If Month < 1 Or Month > 13 Then _
        Throw Cor.NewArgumentOutOfRangeException("Month must be between 1 and 13.", "Month", Month)
    
    GetMonthName = mProps.MonthNames(Month - 1)
End Function

''
' Formats a cDateTime object or Date value in the pattern specified by
' the formatting command. If no command is specified, then 'G' is assumed.
' If the command cannot be found, then a custom pattern is assumed.
'
' @param value The date to be formatted.
' @param fmt The formatting command or custom pattern to format the date to.
' @return The formatted date value.
' @remarks <p>Formatting can be accomplished by either specifying a formatting command,
' or entering a custom date format.<br><br>
' D - LongDatePattern<br>
' d - ShortDateTimePattern<br>
' F - FullDateTimePattern (Long Date and Long Time)<br>
' f - Full date and time (Long Date and Short Time)<br>
' G - General (Short Date and Long Time)<br>
' g - General (Short Date and Short Time)<br>
' m,M - MonthDayPattern<br>
' r,R - RFC1123Pattern<br>
' s - SortableDateTimePattern<br>
' T - LongTimePattern<br>
' t - ShortTimePattern<br>
' U - Full Date and Time (Long Date, Long Time) using universal time<br>
' u - UniversalSortableDateTimePattern<br>
' y,Y - YearMonthPattern<br>
'
Public Function Format(ByRef Value As Variant, Optional ByVal fmt As String) As String
    Call VerifyLoaded
    Format = CustomFormat(cDateTime.GetcDateTime(Value), GetPattern(fmt))
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 equality 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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub CloneHelper(ByRef props As PropsType)
    mProps = props
End Sub

Friend Sub Load(ByVal LCID As Long, ByVal UseUserOverride As Boolean, Optional ByVal Calendar As Calendar)
    If Not CultureTable.IsLoaded Then _
        Throw Cor.NewNotSupportedException("Cannot load DateTimeFormatInfo without culture table.")
    
    Set mProps.Calendar = Calendar
    Call LoadCommon(LCID)
    
    If UseUserOverride Then
        Call LoadUserOverride(LCID)
    Else
        Call LoadFromCultureTable(LCID)
    End If
    mLoaded = True
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub LoadUserOverride(ByVal LCID As Long)
    With mProps
        .CalendarWeekRule = GetLocaleLong(LCID, LOCALE_IFIRSTWEEKOFYEAR)
        .AMDesignator = GetLocaleString(LCID, LOCALE_S1159)
        .PMDesignator = GetLocaleString(LCID, LOCALE_S2359)
        .DateSeparator = GetLocaleString(LCID, LOCALE_SDATE)
        .TimeSeparator = GetLocaleString(LCID, LOCALE_STIME)
        .FirstDayOfWeek = GetLocaleLong(LCID, LOCALE_IFIRSTDAYOFWEEK)
        .LongDatePattern = GetLocaleString(LCID, LOCALE_SLONGDATE)
        .ShortDatePattern = GetLocaleString(LCID, LOCALE_SSHORTDATE)
        .LongTimePattern = GetLocaleString(LCID, LOCALE_STIMEFORMAT)
    End With
End Sub

Private Sub LoadFromCultureTable(ByVal LCID As Long)
    With mProps
        .CalendarWeekRule = CultureTable.GetNumber(LCID, IFIRSTWEEKOFYEAR)
        .AMDesignator = CultureTable.GetString(LCID, SAMDESIGNATOR)
        .PMDesignator = CultureTable.GetString(LCID, SPMDESIGNATOR)
        .DateSeparator = CultureTable.GetString(LCID, SDATESEPARATOR)
        .TimeSeparator = CultureTable.GetString(LCID, STIMESEPARATOR)
        .FirstDayOfWeek = CultureTable.GetNumber(LCID, IFIRSTDAYOFWEEK)
        .LongDatePattern = CultureTable.GetString(LCID, SLONGDATEPATTERN)
        .LongTimePattern = CultureTable.GetString(LCID, SLONGTIMEPATTERN)
        .ShortDatePattern = CultureTable.GetString(LCID, SSHORTDATEPATTERN)
    End With
End Sub

Private Sub LoadCommon(ByVal LCID As Long)
    With mProps
        .ShortTimePattern = CultureTable.GetString(LCID, SSHORTTIMEPATTERN)
        .AbbreviatedDayNames = CultureTable.GetStringArray(LCID, SABBREVIATEDDAYNAMES)
        .AbbreviatedMonthNames = CultureTable.GetStringArray(LCID, SABBREVIATEDMONTHNAMES)
        .DayNames = CultureTable.GetStringArray(LCID, SDAYNAMES)
        .MonthDayPattern = CultureTable.GetString(LCID, SMONTHDAYPATTERN)
        .MonthNames = CultureTable.GetStringArray(LCID, SMONTHNAMES)
        .YearMonthPattern = CultureTable.GetString(LCID, SYEARMONTHPATTERN)
        .AllLongDatePatterns = CultureTable.GetStringArray(LCID, SALLLONGDATEPATTERNS)
        .AllLongTimePatterns = CultureTable.GetStringArray(LCID, SALLLONGTIMEPATTERNS)
        .AllShortDatePatterns = CultureTable.GetStringArray(LCID, SALLSHORTDATEPATTERNS)
        .AllShortTimePatterns = CultureTable.GetStringArray(LCID, SALLSHORTTIMEPATTERNS)
        .AllMonthDayPatterns = CultureTable.GetStringArray(LCID, SALLMONTHDAYPATTERNS)
    End With
End Sub

Private Function CustomFormat(ByRef dt As cDateTime, ByRef Pattern As String) As String
    Dim cnt         As Long
    Dim pos         As Long
    Dim sb          As StringBuilder
    Dim Day         As Long
    Dim Month       As Long
    Dim Year        As Long
    Dim YearMod100  As Long
    Dim Hour        As Long
    Dim HourMod12   As Long
    Dim Minute      As Long
    Dim Second      As Long
    Dim Designator  As String
    Dim Ch          As Integer
    Dim Escaped     As Boolean
    Dim ZoneOffset  As TimeSpan
    Dim Percented   As Boolean
    Dim Quote       As Long
    
    mPattern.SA.pvData = StrPtr(Pattern)
    mPattern.SA.cElements = Len(Pattern)
    Set sb = DateTimeFormatInfo.StringBuilder   ' use a cached builder.
    sb.Length = 0
    
    Day = dt.Day
    Month = dt.Month
    Year = dt.Year
    YearMod100 = Year Mod 100
    Hour = dt.Hour
    HourMod12 = Hour Mod 12
    If HourMod12 = 0 Then HourMod12 = 12    ' we want 12:00:00 AM, not 00:00:00 AM
    Minute = dt.Minute
    Second = dt.Second
    Designator = IIf(Hour < 12, mProps.AMDesignator, mProps.PMDesignator)
    
    Do While pos < mPattern.SA.cElements
        Ch = mPattern.Data(pos)
        cnt = GetRepeatCount(pos)
        
        If Not Escaped Then
            If Quote <> 0 Then
                Select Case Ch
                    Case vbBackSlash:   Escaped = True
                    Case Quote:         Quote = 0
                    Case Else:          Call sb.AppendChar(Ch)
                End Select
                cnt = 1
            
            Else
                Select Case Ch
                    Case vbLowerD:          Call Append1to4CountValue(sb, cnt, Day, mProps.AbbreviatedDayNames(dt.DayOfWeek), mProps.DayNames(dt.DayOfWeek))
                    Case vbUpperM:          Call Append1to4CountValue(sb, cnt, Month, mProps.AbbreviatedMonthNames(Month - 1), mProps.MonthNames(Month - 1))
                    Case vbLowerH:          Call Append1or2DigitNumber(sb, cnt, HourMod12)
                    Case vbUpperH:          Call Append1or2DigitNumber(sb, cnt, Hour)
                    Case vbLowerM:          Call Append1or2DigitNumber(sb, cnt, Minute)
                    Case vbLowerS:          Call Append1or2DigitNumber(sb, cnt, Second)
                    Case vbColon:           Call sb.AppendString(mProps.TimeSeparator)
                    Case vbForwardSlash:    Call sb.AppendString(mProps.DateSeparator)
                    Case vbDoubleQuote:     Quote = vbDoubleQuote
                    Case vbSingleQuote:     Quote = vbSingleQuote
                    
                    Case vbLowerY
                        Select Case cnt
                            Case 1:         Call sb.Append(YearMod100)
                            Case 2:
                                If YearMod100 < 10 Then Call sb.AppendChar(vbZero)
                                Call sb.Append(YearMod100)
                            Case Else
                                Call sb.AppendFormat("{0:d" & cnt & "}", Year)
                        End Select
                        
                    Case vbLowerT
                        If cnt = 1 Then
                            Call sb.AppendString(Designator, 0, 1)
                        Else
                            Call sb.AppendString(Designator)
                        End If
                    
                    Case vbLowerZ
                        If ZoneOffset Is Nothing Then Set ZoneOffset = TimeZone.CurrentTimeZone.GetUtcOffset(dt)
                        Select Case cnt
                            Case 1:         Call sb.AppendString(VBA.Format$(ZoneOffset.Hours, "0;-0"))
                            Case 2:         Call sb.AppendString(VBA.Format$(ZoneOffset.Hours, "00;-00"))
                            Case Else:      Call sb.AppendString(VBA.Format$(ZoneOffset.Hours, "00;-00") & ":" & VBA.Format$(ZoneOffset.Minutes, "00"))
                        End Select
                    
                    Case vbPercent
                        If Percented Then Call FormatError
                        cnt = 1
                    
                    Case vbBackSlash
                        Escaped = True
                        cnt = 1
                    
                    Case vbLowerF
                        Dim secfrac As Long
                        If cnt > 7 Then Call FormatError
                        secfrac = GetSecondsFraction(dt.Ticks)
                        secfrac = (secfrac \ CLng(10 ^ (7 - cnt)))
                        Call sb.AppendFormat("{0:g" & cnt & "}", secfrac)
                        
                    Case Else:              Call sb.AppendChar(Ch)
                End Select
            End If
        Else
            Call sb.AppendChar(Ch)
            Escaped = False
            cnt = 1
        End If
        Percented = (Ch = vbPercent)
        pos = pos + cnt
    Loop
    
    If Quote <> 0 Then _
        Throw Cor.NewFormatException("A matching quote was not found in the format string.")
    
    CustomFormat = sb.ToString
End Function

Private Function GetSecondsFraction(ByRef Ticks As Variant) As Long