stringbuilder.cls

VB 加密----------能够加密解密控件

''
' Returns the fill character used to pad empty space.
'
' @return An Integer representing the AscW of the character.
'
Public Property Get FillCharacter() As Variant
    FillCharacter = mFillChar
End Property

''
' Sets the fill character used to pad empty space.
'
' @param RHS The character as either a String or Integer value.
' @remarks The new value can be either String, in which case the
' first characters is used, or it can be a number.
'
Public Property Let FillCharacter(ByVal RHS As Variant)
    Select Case VarType(RHS)
        Case vbLong, vbInteger, vbByte
            mFillChar = AscW(ChrW$(RHS))
        Case vbString
            mFillChar = AscW(RHS)
        Case Else
            Throw Cor.NewInvalidCastException("Fill Character can be either a string or number.")
    End Select
End Property

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

''
' Inserts a string into the current string value.
'
' @param index The index in the string value to start inserting the new string.
' @param value The string to be inserted.
' @param count The number of times to insert the string.
' @return This instance of StringBuilder
'
Public Function Insert(ByVal Index As Long, ByVal Value As String, Optional ByVal Count As Long = 1) As StringBuilder
    If Index < 0 Or Index > mLength Then _
        Throw Cor.NewIndexOutOfRangeException("index must be non-negative and less than or equal to the length.")
    If Count < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_NeedNonNegNum), "Count", Count)
        
    Dim l As Long
    l = Len(Value)
    If l > 0 And Count > 0 Then
        mLength = InsertSpace(Index, l * Count)
        l = l * 2
        Index = Index * 2
        Do While Count > 0
            Call CopyMemory(ByVal mStringPtr + Index, ByVal StrPtr(Value), l)
            Index = Index + l
            Count = Count - 1
        Loop
    End If
    Set Insert = Me
End Function

''
' Inserts an array of characters into the string value.
'
' @param index The index in the string value to start inserting.
' @param Chars The characters to be inserted.
' @param startindex The index in the Characters to start inserting from.
' @param count The number of characters to be inserted.
' @return This instance of StringBuilder.
'
Public Function InsertChars(ByVal Index As Long, ByRef Chars() As Integer, Optional ByRef StartIndex As Variant, Optional ByRef Count As Variant) As StringBuilder
    Dim ElemCount   As Long
    Dim ElemIndex   As Long
    Dim Result      As Long
    
    Result = GetOptionalArrayRange(SAPtr(Chars), StartIndex, ElemIndex, Count, ElemCount)
    If Result <> NO_ERROR Then _
        ThrowArrayRangeException Result, "Chars", ElemIndex, "StartIndex", ElemCount, "Count", IsMissing(StartIndex)
    If Index < 0 Or Index > mLength Then _
        Throw Cor.NewArgumentOutOfRangeException("Index must be between 0 and then length of the current instance.", "Index", Index)
    
    mLength = InsertSpace(Index, ElemCount)
    Call CopyMemory(mString(Index), Chars(ElemIndex), ElemCount * 2)
    Set InsertChars = Me
End Function

''
' Returns the length of the current string value.
'
' @return The length of the string value.
'
Public Property Get Length() As Long
    Length = mLength
End Property

''
' Sets the length of the current string value.
'
' @param RHS The length of the string value.
' @remarks If the new value is longer than the current length, then the
' new space is padded with FillCharacter (default 32).
'
Public Property Let Length(ByVal RHS As Long)
    If RHS < 0 Then _
        Throw Cor.NewArgumentOutOfRangeException("Length cannot be set less than 0.", "Length", Length)
    
    If RHS > mLength Then
        If RHS > mCapacity Then Call EnsureCapacity(RHS)
        Call Fill(mLength, mFillChar, mCapacity - mLength)
    End If
    mLength = RHS
End Property

''
' Removes a number of characters from the string value.
'
' @param startindex The index in the string value to start removing from.
' @param count The number of characters to remove from the string value.
' @return This instance of StringBuilder.
' @remarks startindex is zero-based.
'
Public Function Remove(ByVal StartIndex As Long, ByVal Count As Long) As StringBuilder
    Dim Result As Long
    Result = VerifyListRange(mLength, StartIndex, Count)
    If Result <> NO_ERROR Then Call ThrowListRangeException(Result, StartIndex, "StartIndex", Count, "Count")
    
    If Count > 0 Then
        Call CopyMemory(ByVal mStringPtr + StartIndex * 2, ByVal mStringPtr + (StartIndex + Count) * 2, (mLength - (StartIndex + Count)) * 2)
        mLength = mLength - Count
    End If
    Set Remove = Me
End Function

''
' Replaces a substring in the string value with a new string.
'
' @param OldValue The substring to be replaced.
' @param NewValue The string to replace the old string with.
' @param StartIndex The index of the start of the substring in the StringBuilder object.
' @param count The number of characters in the StringBuilder object substring.
' @return This instance of StringBuilder.
' @remarks Use index and count to replace the old value with a substring of the new value. index is zero-based.
'
Public Function Replace(ByVal OldValue As String, ByVal NewValue As String, Optional ByRef StartIndex As Variant, Optional ByRef Count As Variant) As StringBuilder
    OldStrSA.pvData = StrPtr(OldValue)
    OldStrSA.cElements = Len(OldValue)

    If OldStrSA.cElements = 0 Then
        Set Replace = Me
        Exit Function
    End If

    Dim MatchCount      As Long
    Dim MatchIndexes()  As Long
    MatchCount = FindMatches(MatchIndexes, StartIndex, Count)

    ' If we have matches then we need to replace them.
    If MatchCount > 0 Then
        Dim NewLength As Long
        NewLength = mLength - ((Len(OldValue) - Len(NewValue)) * MatchCount)

        Select Case NewLength
            Case mLength:       Call ReplaceEqualLength(NewValue, MatchIndexes, MatchCount)
            Case Is < mLength:  Call ReplaceSmallerLength(NewValue, MatchIndexes, MatchCount, Len(OldValue))
            Case Else:          Call ReplaceLargerLength(NewValue, MatchIndexes, MatchCount, Len(OldValue), NewLength)
        End Select

        mLength = NewLength
    End If

    Set Replace = Me
End Function

''
' Returns the current version of the string value.
'
' @param startindex The index to start the return substring from.
' @param length The number of characters to return in the string.
' @return A string or substring representing the internal string of the builder.
' @remarks startindex is zero-based.
'
Public Function ToString(Optional ByRef StartIndex As Variant, Optional ByRef Length As Variant) As String
    Dim ElemCount   As Long
    Dim ElemIndex   As Long
    Dim Result      As Long
    Result = GetOptionalListRange(mLength, StartIndex, ElemIndex, Length, ElemCount)
    If Result <> NO_ERROR Then Call ThrowListRangeException(Result, ElemIndex, "StartIndex", ElemCount, "Length", IsMissing(StartIndex))
    
    If mLength = 0 Then
        ToString = ""
    Else
        ToString = SysAllocStringLen(mStringPtr + ElemIndex * 2, ElemCount)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub Init(ByRef s As String, ByRef StartIndex As Variant, ByRef Count As Variant, ByVal Capacity As Long)
    Call CoTaskMemFree(mStringPtr)
    
    Dim ElemCount As Long
    ElemCount = GetOptionalLong(Count, Len(s))
    
    Dim ElemIndex As Long
    ElemIndex = GetOptionalLong(StartIndex, 0)
    
    Dim Result As Long
    Result = VerifyListRange(Len(s), ElemIndex, ElemCount)
    If Result <> NO_ERROR Then Call ThrowListRangeException(Result, ElemIndex, "StartIndex", ElemCount, "Count", IsMissing(StartIndex))
    
    If ElemCount > Capacity Then Capacity = ElemCount
    If Capacity < DEF_CAPACITY Then Capacity = DEF_CAPACITY
    
    mStringPtr = CoTaskMemAlloc(Capacity * 2)
    mCapacity = Capacity
    mLength = ElemCount
    If ElemCount > 0 Then Call CopyMemory(ByVal mStringPtr, ByVal StrPtr(s) + ElemIndex * 2, ElemCount * 2)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    mFillChar = DEF_FILLCHAR
    mStringPtr = CoTaskMemAlloc(DEF_CAPACITY * 2)
    If mStringPtr = vbNullPtr Then Throw New OutOfMemoryException
    mCapacity = DEF_CAPACITY
    
    With OldStrSA
        .cbElements = 2
        .cDims = 1
        .cElements = &H7FFFFFFF
    End With
    SAPtr(OldStr) = VarPtr(OldStrSA)
    BufStrSA = OldStrSA
    SAPtr(BufStr) = VarPtr(BufStrSA)
    mStringSA = OldStrSA
    SAPtr(mString) = VarPtr(mStringSA)
    mStringSA.pvData = mStringPtr
    
    Call InitWordBuffer(mChars, 0, &H7FFFFFFF)
End Sub

Private Sub Class_Terminate()
    Call CoTaskMemFree(mStringPtr)
    SAPtr(OldStr) = 0
    SAPtr(BufStr) = 0
    SAPtr(mString) = 0
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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Fill(ByVal Index As Long, ByVal Char As Integer, ByVal Count As Long)
    Dim i As Long
    
    For i = Index To Index + Count - 1
        mString(i) = Char
    Next i
End Sub

Private Sub FormatError()
    Throw Cor.NewFormatException("Invalid format specified.")
End Sub

Private Function InsertSpace(ByVal Index As Long, ByVal Size As Long) As Long
    InsertSpace = mLength + Size
    If InsertSpace > mCapacity Then Call EnsureCapacity(InsertSpace)
    If Index < mLength Then
        ' Create space in the string. The new space is uninitialized.
        Call CopyMemory(ByVal mStringPtr + (Index + Size) * 2, ByVal mStringPtr + Index * 2, (mLength - Index) * 2)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend helper methods
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' We can supply a custom formatter through the IFormatProvider interface.
' This article lead me to believe that the StringBuilder.AppendFormat function
' can use an ICustomFormatter object, even though information about it is
' scarce in the MSDN.
'
' "http://www.codeproject.com/csharp/custstrformat.asp"
'
Friend Sub InternalAppendFormat(ByVal Provider As IFormatProvider, ByRef Format As String, ByRef args() As Variant)
    Dim CustomFormatter     As ICustomFormatter
    Dim HasCustomFormatter  As Boolean
    Dim Index               As Long
    Dim Max                 As Long
    Dim SubStringStart      As Long
    
    ' See if the user wants to format anything their own way.
    If Not Provider Is Nothing Then
        Set CustomFormatter = Provider.GetFormat("ICustomFormatter")
        HasCustomFormatter = Not (CustomFormatter Is Nothing)
    End If
    
    Max = Len(Format)
    mChars.SA.pvData = StrPtr(Format)
    mChars.SA.cElements = Max
    
    ' Parse normal substring.
    Do While Index < Max
        Select Case mChars.Data(Index)
            Case OPEN_BRACE
                ' potential escape or format info.
                
                If Index > SubStringStart Then
                    ' If we have some characters, just append them now
                    ' even if the "{" may be escaped. Most times it won't be.
                    Call AppendChars(mChars.Data, SubStringStart, Index - SubStringStart)
                End If
                
                Index = Index + 1
                
                ' We test for escape by checking the next character for a "{".
                ' But if we're out of characters, then we ended with a "{",
                ' and that is an invalid format.
                If Index = Max Then Call FormatError
                
                ' We have enough characters to test for possible escape.
                If mChars.Data(Index) = OPEN_BRACE Then
                    ' escape it by setting the start of the substring to the second one.
                    SubStringStart = Index
                Else
                    Dim ArgIndex        As Long