cultureinfo.cls

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

''
' Returns the NumberFormatInfo associated with this culture.
'
' @return The NumberFormatInfo for this culture that can be used
' to format numbers specific to this culture.
'
Public Property Get NumberFormat() As NumberFormatInfo
    If IsNeutralCulture Then _
        Throw Cor.NewNotSupportedException("Neutral cultures cannot provide formatting.")
    
    If mNumberFormat Is Nothing Then
        Set mNumberFormat = New NumberFormatInfo
        Call mNumberFormat.Load(mProps.LCID, mProps.UseUserOverride)
        mNumberFormat.IsReadOnly = mProps.IsReadOnly
    End If
    Set NumberFormat = mNumberFormat
End Property

''
' Sets the NumberFormatInfo for the specific culture object.
'
' @param RHS The NumberFormatInfo to associate with this object instance.
'
Public Property Set NumberFormat(ByVal RHS As NumberFormatInfo)
    Call VerifyWritable
    If RHS Is Nothing Then _
        Throw Cor.NewArgumentNullException("Cannot set NumberFormat to Nothing.", "NumberFormat")
    If IsNeutralCulture Then _
        Throw Cor.NewNotSupportedException("Neutral cultures cannot provide formatting.")
        
    Set mNumberFormat = RHS
End Property

''
' Returns the DateTimeFormatInfo associated with this culture.
'
' @return The DateTimeFormatInfo for this culture that can be used
' to format dates and times specific to this culture.
'
Public Property Get DateTimeFormat() As DateTimeFormatInfo
    If IsNeutralCulture Then _
        Throw Cor.NewNotSupportedException("Neutral cultures cannot provide formatting.")
        
    If mDateTimeFormat Is Nothing Then
        Set mDateTimeFormat = New DateTimeFormatInfo
        Call mDateTimeFormat.Load(mProps.LCID, mProps.UseUserOverride, Me.Calendar)
        mDateTimeFormat.IsReadOnly = mProps.IsReadOnly
    End If
    Set DateTimeFormat = mDateTimeFormat
End Property

''
' Sets the DateTimeFormatInfo for the specific culture object.
'
' @param RHS The DateTimeFormatInfo object to associate with this object instance.
'
Public Property Set DateTimeFormat(ByVal RHS As DateTimeFormatInfo)
    Call VerifyWritable
    If RHS Is Nothing Then _
        Throw Cor.NewArgumentNullException("Cannot set DateTimeFormat to Nothing.", "DateTimeFormat")
    If IsNeutralCulture Then _
        Throw Cor.NewNotSupportedException("Neutral cultures cannot provide formatting.")
    
    Set mDateTimeFormat = RHS
End Property

''
' Returns the parent culture for this culture.
'
' @return The parent culture for this culture. If this culture is
' invariant, then invariant is returned.
'
Public Property Get Parent() As CultureInfo
    Set Parent = Cor.NewCultureInfo(mProps.ParentLCID)
End Property

''
' Returns a string representation of this object instance.
'
' @return String representing this instance.
Public Function ToString() As String
    ToString = Me.Name
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
    If IsObject(Value) Then
        If Value Is Nothing Then Exit Function
        
        Dim c As CultureInfo
        If TypeOf Value Is CultureInfo Then
            Set c = Value
            Equals = (c.LCID = mProps.LCID)
        End If
    End If
End Function

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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByRef NameOrLCID As Variant, ByVal UseUserOverride As Boolean)
    Dim ID As Long
    
    Select Case VarType(NameOrLCID)
        Case vbLong, vbInteger, vbByte
            ID = NameOrLCID
        Case vbString
            If CultureTable.IsLoaded Then ID = CultureTable.GetCultureID(NameOrLCID)
        Case Else
            Throw Cor.NewArgumentException("Invalid Culture Identifier.", "NameOrLCID")
    End Select
    If UseUserOverride Then mProps.UseUserOverride = (GetUserDefaultLCID = ID)
    Call Load(ID)
End Sub

Friend Sub CloneHelper(ByRef props As PropsType, ByVal dtInfo As DateTimeFormatInfo, ByVal nInfo As NumberFormatInfo, ByVal calInfo As Calendar)
    mProps = props
    Set mDateTimeFormat = dtInfo
    Set mNumberFormat = nInfo
    Set mCalendar = calInfo
End Sub

Friend Property Let IsReadOnly(ByVal RHS As Boolean)
    mProps.IsReadOnly = RHS
    If Not mDateTimeFormat Is Nothing Then mDateTimeFormat.IsReadOnly = RHS
    If Not mNumberFormat Is Nothing Then mNumberFormat.IsReadOnly = RHS
End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VerifyWritable()
    If mProps.IsReadOnly Then Throw Cor.NewInvalidOperationException("Culture is Read-Only.")
End Sub

Private Sub VerifyLoaded()
    If Not mLoaded Then Call Load(INVARIANT_LCID)
End Sub

Private Sub Load(ByVal LCID As Long)
    If CultureTable.IsLoaded Then
        With mProps
            .LCID = LCID
            .ParentLCID = CultureTable.GetNumber(LCID, IPARENTLCID)
            .Name = CultureTable.GetString(LCID, SNAME)
            .EnglishName = CultureTable.GetString(LCID, SENGLISHNAME)
            .DisplayName = CultureTable.GetString(LCID, SDISPLAYNAME)
            .NativeName = CultureTable.GetString(LCID, SNATIVENAME)
            .ThreeLetterISOLanguageName = CultureTable.GetString(LCID, STHREELETTERISOLANGUAGENAME)
            .ThreeLetterWindowLanguageName = CultureTable.GetString(LCID, STHREELETTERWINDOWSLANGUAGENAME)
            .TwoLetterISOLanguageName = CultureTable.GetString(LCID, STWOLETTERISOLANGUAGENAME)
        End With
    Else
        Call LoadDefault
    End If
    
    mLoaded = True
End Sub

Private Sub LoadDefault()
    With mProps
        .LCID = INVARIANT_LCID
        .ParentLCID = INVARIANT_LCID
        .Name = ""
        .EnglishName = "Invariant Language (Invariant Country)"
        .DisplayName = "Invariant Language (Invariant Country)"
        .NativeName = "Invariant Language (Invariant Country)"
        .ThreeLetterISOLanguageName = "IVL"
        .ThreeLetterWindowLanguageName = "IVL"
        .TwoLetterISOLanguageName = "iv"
    End With
End Sub

Private Function GetCalendar(ByVal CalendarType As Long) As Calendar
    Select Case CalendarType
        Case CAL_GREGORIAN, _
             CAL_GREGORIAN_US, _
             CAL_GREGORIAN_ME_FRENCH, _
             CAL_GREGORIAN_ARABIC, _
             CAL_GREGORIAN_XLIT_ENGLISH, _
             CAL_GREGORIAN_XLIT_FRENCH
            
            Dim g As New GregorianCalendar
            g.CalendarType = CalendarType
            Set GetCalendar = g
            
        Case CAL_JAPAN:     Set GetCalendar = New JapaneseCalendar
        Case CAL_TAIWAN:    Set GetCalendar = New TaiwanCalendar
        Case CAL_KOREA:     Set GetCalendar = New KoreanCalendar
        Case CAL_HIJRI:     Set GetCalendar = New HijriCalendar
        Case CAL_THAI:      Set GetCalendar = New ThaiBuddhistCalendar
        Case CAL_HEBREW:    Set GetCalendar = New HebrewCalendar
        Case CAL_JULIAN:    Set GetCalendar = New JulianCalendar
        Case Else:          Set GetCalendar = New GregorianCalendar
    End Select
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_ReadProperties(PropBag As PropertyBag)
    With PropBag
        mProps.LCID = .ReadProperty(PROP_LCID)
        mProps.EnglishName = .ReadProperty(PROP_ENGLISHNAME)
        mProps.DisplayName = .ReadProperty(PROP_DISPLAYNAME)
        mProps.NativeName = .ReadProperty(PROP_NATIVENAME)
        mProps.Name = .ReadProperty(PROP_NAME)
        mProps.ParentLCID = .ReadProperty(PROP_PARENTLCID)
        mProps.ThreeLetterISOLanguageName = .ReadProperty(PROP_THREELETTERISOLANGUAGENAME)
        mProps.ThreeLetterWindowLanguageName = .ReadProperty(PROP_THREELETTERWINDOWSLANGUAGENAME)
        mProps.TwoLetterISOLanguageName = .ReadProperty(PROP_TWOLETTERISOLANGUAGENAME)
        mProps.UseUserOverride = .ReadProperty(PROP_USEUSEROVERRIDE)
        mProps.IsReadOnly = .ReadProperty(PROP_ISREADONLY)
        Set mDateTimeFormat = .ReadProperty(PROP_DATETIMEFORMAT)
        Set mNumberFormat = .ReadProperty(PROP_NUMBERFORMAT)
        Set mCalendar = .ReadProperty(PROP_CALENDAR)
    End With
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag)
    With PropBag
        Call .WriteProperty(PROP_LCID, mProps.LCID)
        Call .WriteProperty(PROP_PARENTLCID, mProps.ParentLCID)
        Call .WriteProperty(PROP_NAME, mProps.Name)
        Call .WriteProperty(PROP_ENGLISHNAME, mProps.EnglishName)
        Call .WriteProperty(PROP_DISPLAYNAME, mProps.DisplayName)
        Call .WriteProperty(PROP_NATIVENAME, mProps.NativeName)
        Call .WriteProperty(PROP_THREELETTERISOLANGUAGENAME, mProps.ThreeLetterISOLanguageName)
        Call .WriteProperty(PROP_THREELETTERWINDOWSLANGUAGENAME, mProps.ThreeLetterWindowLanguageName)
        Call .WriteProperty(PROP_TWOLETTERISOLANGUAGENAME, mProps.TwoLetterISOLanguageName)
        Call .WriteProperty(PROP_USEUSEROVERRIDE, mProps.UseUserOverride)
        Call .WriteProperty(PROP_ISREADONLY, mProps.IsReadOnly)
        Call .WriteProperty(PROP_DATETIMEFORMAT, mDateTimeFormat)
        Call .WriteProperty(PROP_NUMBERFORMAT, mNumberFormat)
        Call .WriteProperty(PROP_CALENDAR, mCalendar)
    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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ICloneable Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function ICloneable_Clone() As Object
    Set ICloneable_Clone = Clone
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   IFormatProvider Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IFormatProvider_GetFormat(ByVal FormatType As String) As Object
    Set IFormatProvider_GetFormat = GetFormat(FormatType)
End Function