闪电般的StringBuilder

#1 楼

'******
'* v2 *
'******

Private Const DEFAULT_CAPACITY As Long = &H10

ReDim m_stringBuffer(0 To (DEFAULT_CAPACITY * 2) - 1) 'Each unicode character is 2 bytes

Public Property Get Length() As Long
    Length = m_currLen / 2
End Property

Public Function Append(strString As String) As clsStringBuilder

#2 楼

For j = 0 To 1000
    Dim csb As New clsStringBuilder

    StartTime = MicroTimer()
    For i = 0 To 100000
        csb.Append "Hello World;"
    Next
Next

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
    (ByVal dst As Long, ByVal src As Long, ByVal Length As Long)

Private Const DEFAULT_CAPACITY As Long = 16
Private m_currLen As Long
Private m_stringBuffer() As Byte

Private Sub Class_Initialize()
    ReDim m_stringBuffer(0 To (DEFAULT_CAPACITY + DEFAULT_CAPACITY) - 1) 'Each unicode character is 2 bytes
End Sub

Public Function Append(strString As String) As StringBuilder
On Error GoTo derp

    Dim uBuffer As Long
    uBuffer = UBound(m_stringBuffer)

    Dim lengthB As Long
    lengthB = LenB(strString)

    Dim sPtr As Long
    sPtr = StrPtr(strString)

    Dim currLen As Long
    currLen = m_currLen + lengthB

    Select Case currLen
        Case Is < uBuffer
            CopyMemory VarPtr(m_stringBuffer(m_currLen)), sPtr, lengthB
        Case Is < (uBuffer + uBuffer)
            Expand
            CopyMemory VarPtr(m_stringBuffer(m_currLen)), sPtr, lengthB
        Case Else
            Expand currLen
            CopyMemory VarPtr(m_stringBuffer(m_currLen)), sPtr, lengthB
    End Select

    m_currLen = currLen
    Set Append = Me
    Exit Function

derp:
    Stop
    Resume
End Function

Public Property Get Length() As Long
    Length = m_currLen * 0.5
End Property

Public Property Get Capacity() As Long
    Capacity = UBound(m_stringBuffer)
End Property

Private Sub Expand(Optional newSize As Long = 0)
    Select Case newSize
        Case Is = 0
            ReDim Preserve m_stringBuffer(0 To (UBound(m_stringBuffer) + UBound(m_stringBuffer)) + 1)
        Case Else
            ReDim Preserve m_stringBuffer(0 To newSize - 1)
    End Select
End Sub

Public Function ToString() As String
    ToString = Mid$(m_stringBuffer, 1, m_currLen * 0.5)
End Function

#3 楼

Dim MyBuffer() As String
Dim MyCurrentIndex As Long
Dim MyMaxIndex As Long

Private Sub Class_Initialize()

    MyCurrentIndex = 0
    MyMaxIndex = 16
    ReDim MyBuffer(1 To MyMaxIndex)

End Sub

'Appends the given Text to this StringBuilder
Public Sub Append(Text As String)

    MyCurrentIndex = MyCurrentIndex + 1

    If MyCurrentIndex > MyMaxIndex Then
        MyMaxIndex = 2 * MyMaxIndex
        ReDim Preserve MyBuffer(1 To MyMaxIndex)
    End If
    MyBuffer(MyCurrentIndex) = Text

End Sub

'Returns the text in this StringBuilder
'Optional Parameter: Separator (default vbNullString) used in joining components
Public Function ToString(Optional Separator As String = vbNullString) As String

    If MyCurrentIndex > 0 Then
        ReDim Preserve MyBuffer(1 To MyCurrentIndex)
        MyMaxIndex = MyCurrentIndex
        ToString = Join(MyBuffer, Separator)
    End If

End Function

#4 楼

Option Compare Text
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal dst As Long, ByVal src As Long, ByVal Length As Long)

Private Const InitialCharCount As Long = 16
' Define members
Private mUBound As Long
Private mString() As Byte

Private Sub Class_Initialize()
    Clear
End Sub

Public Sub Clear()
    mUBound = -1
    ReDim mString(0 To InitialCharCount * 2 - 1) 'Each unicode character is 2 bytes
End Sub

Public Function Append(value As String) As StringBuilder
Dim NewUBound As Long
Dim CapacityUBound As Long
On Error GoTo Failed
    NewUBound = mUBound + LenB(value)

    If NewUBound > UBound(mString) Then
        CapacityUBound = UBound(mString) * 2 + 1
        If NewUBound > CapacityUBound Then CapacityUBound = NewUBound * 2 + 1
        ReDim Preserve mString(0 To CapacityUBound)
    End If
    CopyMemory VarPtr(mString(mUBound + 1)), StrPtr(value), LenB(value)

    mUBound = NewUBound
    Set Append = Me
    Exit Function

Failed:
    Stop
    Resume
End Function

Public Property Get Length() As Long
    Length = (mUBound + 1) / 2
End Property

Public Function ToString() As String
    ToString = Mid(mString, 1, Length)
End Function