inifile.cls

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

' @param Key The key in the section of an INI file to retrieve the value of.
' @param Default The default value to return if the key is not found in the section, or
' the value could not be converted to a Decimal.
' @remarks An INI file contains all values as Strings. The value is converted back
' into a Decimal using the CDec function. If an error happens, then the default is returned.
'
Public Function GetDecimal(ByVal Section As String, ByVal Key As String, Optional ByVal Default As Variant) As Variant
    GetDecimal = ConvertTo(vbDecimal, GetString(Section, Key), CDec(Default))
End Function

''
' Returns a cDateTime value from the specified key in the specified section of an INI file.
'
' @param Section The section within the INI file to search for the key.
' @param Key The key in the section of an INI file to retrieve the value of.
' @param Default The default value to return if the key is not found in the section, or
' the value could not be converted to a cDateTime.
' @remarks An INI file contains all values as Strings. The value is converted back
' into a cDateTime using the Cor.NewDate function. If an error happens, then the default is returned.
' </p>Passing in Nothing as the default will return a <b>cDateTime</b> of #12:00:00 AM# for the default.</p>
'
Public Function GetDateTime(ByVal Section As String, ByVal Key As String, Optional ByVal Default As cDateTime) As cDateTime
    On Error GoTo errDefault
    
    Dim s As String
    s = GetString(Section, Key)
    If Len(s) > 0 Then
        Set GetDateTime = Cor.NewDate(CDate(s))
        Exit Function
    End If
    
errDefault:
    If Default Is Nothing Then
        Set Default = cDateTime.FromOADate(#12:00:00 AM#)
    Else
        Set GetDateTime = Default
    End If
End Function

''
' Returns a TimeSpan value from the specified key in the specified section of an INI file.
'
' @param Section The section within the INI file to search for the key.
' @param Key The key in the section of an INI file to retrieve the value of.
' @param Default The default value to return if the key is not found in the section, or
' the value could not be converted to a TimeSpan.
' @remarks An INI file contains all values as Strings. The value is converted back
' into a TimeSpan by first testing if the string is a date and taking the Time
' portion, otherwise, the normal TimeSpan.Parse method is used. This expects the
' string to be in the TimeSpan format. If an error happens, then the default is returned.
' <p>Passing in Nothing for the default will return <b>TimeSpan.Zero</b> for the default.</p>
'
Public Function GetTimeSpan(ByVal Section As String, ByVal Key As String, Optional ByVal Default As TimeSpan) As TimeSpan
    On Error GoTo errDefault
    
    Dim s As String
    s = GetString(Section, Key)
    If Len(s) > 0 Then
        If IsDate(s) Then
            Set GetTimeSpan = Cor.NewTime(CDate(s))
        Else
            Set GetTimeSpan = TimeSpan.Parse(s)
        End If
        Exit Function
    End If
    
errDefault:
    If Default Is Nothing Then
        Set GetTimeSpan = TimeSpan.Zero
    Else
        Set GetTimeSpan = Default
    End If
End Function

''
' Returns a list of section names in an INI file.
'
' @return An array of section names, or a zero-length array if no sections exist.
'
Public Function GetSectionNames() As String()
    GetSectionNames = GetList(vbNullString, vbNullString, 512)
End Function

''
' Returns a list of key names in an INI file.
'
' @param Section The section within an INI file to retrieve key names.
' @return An array of key names from a section, or a zero-length array if no keys exist in the section.
'
Public Function GetKeyNames(ByVal Section As String) As String()
    If Len(Section) = 0 Then _
        Throw Cor.NewArgumentException("Section cannot be an empty string.", "Section")

    GetKeyNames = GetList(Section, vbNullString, 512)
End Function

''
' Deletes a key-value pair in a specific section within an INI file.
'
' @param Section The section the key-value pair is to be deleted from.
' @param Key The key of the key-value pair to be deleted.
'
Public Sub DeleteKey(ByVal Section As String, ByVal Key As String)
    If Len(Section) = 0 Then _
        Throw Cor.NewArgumentException("Section cannot be an empty string.", "Section")
    If Len(Key) = 0 Then _
        Throw Cor.NewArgumentException("Key cannot be an empty string.", "Key")
    
    If WritePrivateProfileString(Section, Key, vbNullString, mFileName) = BOOL_FALSE Then IOError Err.LastDllError
    If mAutoFlush Then Call Flush
End Sub

''
' Deletes an entire section from an INI file, including all key-value pairs.
'
' @param Section The name of the section to be deleted from an INI file.
'
Public Sub DeleteSection(ByVal Section As String)
    If Len(Section) = 0 Then _
        Throw Cor.NewArgumentException("Section cannot be an empty string.", "Section")
    
    If WritePrivateProfileString(Section, vbNullString, vbNullString, mFileName) = BOOL_FALSE Then IOError Err.LastDllError
    If mAutoFlush Then Call Flush
End Sub

''
' Returns an IDictionary object containing the key-value pairs from a section in an INI file.
'
' @param Section The section to retrieve all the key-value pairs from.
' @return An IDictionary object containing zero or more key-value pairs.
'
Public Function GetValues(ByVal Section As String) As IDictionary
    If Len(Section) = 0 Then _
        Throw Cor.NewArgumentException("Section cannot be an empty string.", "Section")
    
    Dim Buf     As String
    Dim Size    As Long
    Size = 16384
    Do
        Size = Size * 2
        If Not Environment.IsNT Then Size = MathExt.Min(32767, Size)
        
        Buf = String$(Size, vbNullChar)
        Size = GetPrivateProfileSection(Section, Buf, Size, mFileName)
    Loop While Size = Len(Buf) - 2
    
    Dim Ret As Hashtable
    Set Ret = Cor.NewHashtable(hcp:=New CaseInsensitiveHashCodePrvdr, Comparer:=New CaseInsensitiveComparer)
    
    If Size > 0 Then
        Dim Entries() As String
        Entries = Split(Left$(Buf, Size - 1), vbNullChar)
    
        Dim KeyValue()  As String
        Dim i           As Long
        For i = 0 To UBound(Entries)
            KeyValue = Split(Entries(i), "=", 2)
            If UBound(KeyValue) = 1 Then
                Ret(KeyValue(0)) = Trim$(KeyValue(1))
            Else
                Ret(KeyValue(0)) = ""
            End If
        Next i
    End If
    
    Set GetValues = Ret
End Function

''
' Returns a SectionWriter used to create entire sections withing an INI file at once.
'
' @param Section The section to create using the writer.
' @return The SectionWriter used to create an entier section.
' @see INISectionWriter
'
Public Function GetSectionWriter(ByVal Section As String) As IResourceWriter
    Dim Ret As New INISectionWriter
    Call Ret.Init(mFileName, Section)
    Set GetSectionWriter = Ret
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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByVal FileName As String)
    If Len(FileName) = 0 Then _
        Throw Cor.NewArgumentException("FileName cannot be empty.", "FileName")
    
    mFileName = FileName
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function ConvertTo(ByVal ConvertType As VbVarType, ByRef s As String, ByRef Default As Variant) As Variant
    On Error GoTo errDefault
    Select Case ConvertType
        Case vbInteger:     ConvertTo = CInt(s)
        Case vbLong:        ConvertTo = CLng(s)
        Case vbSingle:      ConvertTo = CSng(s)
        Case vbDouble:      ConvertTo = CDbl(s)
        Case vbCurrency:    ConvertTo = CCur(s)
        Case vbDate:        ConvertTo = CDate(s)
        Case vbBoolean:     ConvertTo = CBool(s)
        Case vbDecimal:     ConvertTo = CDec(s)
        Case vbByte:        ConvertTo = CByte(s)
    End Select
    Exit Function
    
errDefault:
    ConvertTo = Default
End Function

Private Function GetList(ByRef Section As String, ByRef Key As String, ByVal BufferSize As Long) As String()
    Dim Buf As String
    
    Do
        BufferSize = BufferSize * 2
        Buf = String$(BufferSize, vbNullChar)
        BufferSize = GetPrivateProfileString(Section, Key, "", Buf, BufferSize, mFileName)
    Loop While BufferSize = Len(Buf) - 1
    
    Dim Ret() As String
    If BufferSize > 0 Then
        Ret = Split(cString.TrimEnd(Left$(Buf, BufferSize - 1), vbNullChar), vbNullChar)
    Else
        Ret = Cor.NewStrings()
    End If
    
    GetList = Ret
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   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