stringbuilder.cls

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

                    Dim ArgWidth        As Long
                    Dim ArgFormatting   As String
                    
                    ' must be format info within a "{}", so call the parser for it.
                    Index = ParseArgumentFormatting(Index, ArgIndex, ArgWidth, ArgFormatting)
                    If ArgIndex < 0 Or ArgIndex > UBound(args) Then _
                        Throw Cor.NewFormatException("The argument index must be from 0 to " & UBound(args) & ".")
                        
                    ' append formatted argument here.
                    Dim s As String
                    
                    ' Set this because we are in a loop and always
                    ' need to begin with a vbNullString.
                    s = vbNullString
                    
                    ' Give a custom formatter first shot at formatting.
                    If HasCustomFormatter Then
                        s = CustomFormatter.Format(ArgFormatting, args(ArgIndex), Provider)
                    End If
                    
                    ' We distinguish between a null string and an empty string.
                    ' Null string indicates that the value was not formatted.
                    If StrPtr(s) = vbNullPtr Then
                        s = Convert.ToString(args(ArgIndex), ArgFormatting, Provider)
                    End If
                    
                    ' Add leading padding.
                    If ArgWidth > Len(s) Then
                        Call AppendChar(vbSpace, ArgWidth - Len(s))
                    End If
                    
                    ' Finally append the formatted value to the string.
                    Call AppendQuick(s)
                    
                    ' Add trailing padding.
                    If -ArgWidth > Len(s) Then
                        Call AppendChar(vbSpace, (-ArgWidth) - Len(s))
                    End If
                    
                    SubStringStart = Index + 1
                    
                End If
            Case CLOSE_BRACE
                ' must be escaped or else it is a format error.
                
                Index = Index + 1
                
                ' Need enough characters to test for escape.
                If Index = Max Then Call FormatError
                
                If mChars.Data(Index) = CLOSE_BRACE Then
                    ' escape it and add the substring to this point.
                    ' The substring ends one character back because we
                    ' don't want to include both "}}" in the substring.
                    If Index - 1 > SubStringStart Then
                        ' Append the current substring.
                        Call AppendChars(mChars.Data, SubStringStart, Index - SubStringStart - 1)
                    End If
                    SubStringStart = Index
                Else
                    ' we failed to escape it, so there was no matching "{".
                    Call FormatError
                End If
        End Select
        Index = Index + 1
    Loop
    
    If Index > SubStringStart Then
        ' If we have some characters, just append them now.
        Call AppendChars(mChars.Data, SubStringStart, Index - SubStringStart)
    End If
End Sub

' We must be inside "{}". We must end with a matching "}" or it is a format error.
'
' @param Index The index of the first character after the "{".
' @param ArgIndex The index of the argument in the Args array.
' @param ArgWidth The width of the column the argument will be displayed in.
' @param ArgFormat The format information used to determine formatting for the argument.
' @return The index of the terminating "}".
'
Private Function ParseArgumentFormatting(ByVal Index As Long, ByRef ArgIndex As Long, ByRef ArgWidth As Long, ByRef ArgFormat As String) As Long
    Dim Max As Long
    Max = mChars.SA.cElements
    
    ' Get the argument index.
    ArgIndex = ParseNumber(Index)
    
    Index = ConsumeSpaces(Index)
    
    With mChars
        ' Check if a column size is being defined.
        If .Data(Index) = vbComma Then
            Index = ConsumeSpaces(Index + 1)
            
            ' Get the column width and aligment. Remember
            ' negative values mean align left in the column.
            ArgWidth = ParseNumber(Index)
            
            Index = ConsumeSpaces(Index)
        Else
            ' Make sure they know there was no width specified.
            ArgWidth = 0
        End If
        
        ' Check if formatting is being specified.
        If .Data(Index) = vbColon Then
            Dim StartIndex As Long
            
            ' everything from here to the "}" is part of the argument formatting.
            Index = Index + 1
            StartIndex = Index
            Do
                ' can never reach the end until after a "}".
                If Index = Max Then FormatError
                If .Data(Index) = CLOSE_BRACE Then
                    ArgFormat = SysAllocStringLen(VarPtr(.Data(StartIndex)), Index - StartIndex)
                    Exit Do
                End If
                Index = Index + 1
            Loop
        Else
            ' Make sure we let them know that no formatting was supplied.
            ArgFormat = vbNullString
        End If
        
        ' if we get here we should have reached the closing "}".
        If .Data(Index) <> CLOSE_BRACE Then FormatError
    End With
    ParseArgumentFormatting = Index
End Function

''
' Advances the index to the next non-space character.
'
' @param The index to the first space to be consumed.
' @return The index of the first character after the contiguous
' stream of spaces have been consumed.
'
Private Function ConsumeSpaces(ByVal Index As Long) As Long
    Dim Max As Long
    Max = mChars.SA.cElements
    
    Do
        ' Can never hit the end consuming spaces.
        If Index = Max Then Call FormatError
        If mChars.Data(Index) <> vbSpace Then Exit Do
        Index = Index + 1
    Loop
    
    ConsumeSpaces = Index
End Function

''
' Parses out a positive or negative number.
'
' @param Index The index to the first digit or the "-" preceeding the first digit.
' @return The number that was parsed.
' @remarks The Index is passed by Reference and will be altered.
'
Private Function ParseNumber(ByRef Index As Long) As Long
    Dim Max As Long
    Max = mChars.SA.cElements
    
    Dim sign As Long
    sign = 1
    
    Dim FirstCharIndex As Long
    FirstCharIndex = Index
    
    Dim Number As Long
    Do
        ' We can never hit the end parsing a number.
        If Index = Max Then Call FormatError
        
        Dim Ch As Integer
        Ch = mChars.Data(Index)
        Select Case Ch
            Case vbZero To vbNine
                ' Keep adding digits to the number
                Number = Number * 10 + Ch - vbZero
            Case vbMinus
                ' The "-" can only be the first character.
                If Index <> FirstCharIndex Then Call FormatError
                sign = -1
            Case Else
                ' we have reached the end of the number, so exit.
                Exit Do
        End Select
        Index = Index + 1
    Loop
    
    ParseNumber = Number * sign
End Function

''
' Loops through the string buffer finding all matching occurrences of the old value
' and storing the index for each match found.
'
' Returns the number of matches found.
Private Function FindMatches(ByRef MatchIndexes() As Long, ByRef StartIndex As Variant, ByRef Count As Variant) As Long
    Dim ElemCount   As Long
    Dim ElemIndex   As Long
    Dim Result      As Long
    Result = GetOptionalLongPair(StartIndex, 0, ElemIndex, Count, mLength, ElemCount)
    If Result <> NO_ERROR Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Result))
    
    Result = VerifyListRange(mLength, ElemIndex, ElemCount)
    If Result <> NO_ERROR Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Result))

    ' We'll cache this since we'll be hitting it constantly.
    Dim FirstOldValueChar As Long
    FirstOldValueChar = OldStr(0)
    
    ' Don't need to search at the end if the old value
    ' can't fit. If the end matches the old value, then
    ' the inner loop will finish out the matching.
    ElemCount = ElemCount - OldStrSA.cElements + 1
    
    Dim MatchCount As Long
    ReDim MatchIndexes(0 To mLength)
    
    ' Loop through the current StringBuilder string trying to find
    ' all the matches against the old value to be replaced. If a
    ' match is found, then the index to that match is stored for
    ' future usage when replacing the matched old values with the new.
    Do While ElemCount > 0
        ' Found the start of a possible match.
        If mString(ElemIndex) = FirstOldValueChar Then
            ' We'll be opitmistic and assume a match.
            Dim Matched As Boolean
            Matched = True
            
            ' We optimistically save the index now
            ' because we'll be changing it while
            ' matching occurs.
            MatchIndexes(MatchCount) = ElemIndex
            
            ' Start with the second character.
            Dim i As Long
            For i = 1 To OldStrSA.cElements - 1
                If mString(ElemIndex + i) <> OldStr(i) Then
                    Matched = False
                    Exit For
                End If
            Next i
                
            If Matched Then
                MatchCount = MatchCount + 1
                ElemIndex = ElemIndex + OldStrSA.cElements - 1
                ElemCount = ElemCount - OldStrSA.cElements + 1
            End If
        End If
        
        ElemIndex = ElemIndex + 1
        ElemCount = ElemCount - 1
    Loop

    FindMatches = MatchCount
End Function

''
' Optimized to simply copy the new value over the old value within the original buffer.
'
' @remarks This is used when the old and new values are the same length, resulting in
' no change in the size of the final string.
'
Private Sub ReplaceEqualLength(ByRef NewValue As String, ByRef MatchIndexes() As Long, ByVal MatchCount As Long)
    Dim NewValuePtr As Long
    NewValuePtr = StrPtr(NewValue)
    
    Dim AmountToCopy As Long
    AmountToCopy = LenB(NewValue)
    
    Dim i As Long
    For i = 0 To MatchCount - 1
        Call CopyMemory(mString(MatchIndexes(i)), ByVal NewValuePtr, AmountToCopy)
    Next i
End Sub

''
' This will simply use the original string buffer as the source and destination buffers.
'
' @remarks Since the resulting string will be smaller, there is no fear of overwritting
' any original text that needs to end up in the final string.
'
Private Sub ReplaceSmallerLength(ByRef NewValue As String, ByRef MatchIndexes() As Long, ByVal MatchCount As Long, ByVal OldValueLength As Long)
    Call ReplaceMatches(mStringPtr, mStringPtr, NewValue, MatchIndexes, MatchCount, OldValueLength)
End Sub

''
' A new buffer will need to be allocated because the final string will be longer than the original.
'
' @remarks This will use the original string buffer as the source and a newly
' allocated buffer as the destination. Once the replacement has been completed,
' the newly allocated buffer will become the string buffer and the string buffer
' memory will be released.
'
Private Sub ReplaceLargerLength(ByRef NewValue As String, ByRef MatchIndexes() As Long, ByVal MatchCount As Long, ByVal OldValueLength As Long, ByVal NewLength As Long)
    Dim NewCapacity As Long
    NewCapacity = MathExt.Max(NewLength, mCapacity)
    
    Dim NewBuffer As Long
    NewBuffer = CoTaskMemAlloc(NewCapacity * 2)
    If NewBuffer = vbNullPtr Then Throw New OutOfMemoryException
    
    Call ReplaceMatches(mStringPtr, NewBuffer, NewValue, MatchIndexes, MatchCount, OldValueLength)
    
    Call CoTaskMemFree(mStringPtr)
    mStringPtr = NewBuffer
    mStringSA.pvData = NewBuffer
    mCapacity = NewCapacity
End Sub

''
' Performs the replacement of old values with new values, copying the unaltered text from the
' source buffer and placing the final unaltered text plus newly replaced text in the destination buffer.
'
Private Sub ReplaceMatches(ByVal lpSourceBuffer As Long, ByVal lpDestBuffer As Long, ByRef NewValue As String, ByRef MatchIndexes() As Long, ByVal MatchCount As Long, ByVal OldValueLength As Long)
    Dim NewValuePtr As Long
    NewValuePtr = StrPtr(NewValue)
    
    Dim NewValueLen As Long
    NewValueLen = LenB(NewValue)
    
    Dim OriginalIndex   As Long
    Dim AmountToCopy    As Long
    Dim i               As Long
    For i = 0 To MatchCount - 1
        AmountToCopy = MatchIndexes(i) - OriginalIndex
        
        If AmountToCopy > 0 Then
            Call CopyMemory(ByVal lpDestBuffer, ByVal lpSourceBuffer + (OriginalIndex * 2), AmountToCopy * 2)
            lpDestBuffer = lpDestBuffer + AmountToCopy * 2
        End If
        
        If NewValueLen > 0 Then
            Call CopyMemory(ByVal lpDestBuffer, ByVal NewValuePtr, NewValueLen)
            lpDestBuffer = lpDestBuffer + NewValueLen
        End If
        
        OriginalIndex = OriginalIndex + AmountToCopy + OldValueLength
    Next i
    
    If OriginalIndex < mLength Then
        Call CopyMemory(ByVal lpDestBuffer, ByVal lpSourceBuffer + (OriginalIndex * 2), (mLength - MatchIndexes(MatchCount - 1) + OldStrSA.cElements + 1) * 2)
    End If
End Sub