String builder class for VB/VBA

ByteStringBuilder.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ByteStringBuilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Author: Megan Leet
'Much faster than concatenating lots of strings, also some additional functionality

Private Const BUF_SIZE As Long = &H10
Private buf() As Byte
Private totalBytes As Long 'Actual amount of bytes being used, not just the capacity

Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal length As Long)
Private Declare Sub RtlZeroMemory Lib "kernel32" (ptr As Any, ByVal cnt As Long)

Public Function reverse() As ByteStringBuilder
Attribute reverse.VB_Description = "Reverses the order of the characters"
    If totalBytes = 0 Then
        Set reverse = Me
        Exit Function
    End If
    Dim i As Long, j As Long, tempChar As Integer
    i = length - 1
    Do While i > j
        RtlMoveMemory tempChar, buf(i * 2), 2
        RtlMoveMemory buf(i * 2), buf(j * 2), 2
        RtlMoveMemory buf(j * 2), tempChar, 2
        i = i - 1
        j = j + 1
    Loop
    Set reverse = Me
End Function

Public Function insert(offset As Long, s As String) As ByteStringBuilder
Attribute insert.VB_Description = "Inserts a string directly after the nth character"
    'Inserts a string just after the offsetsth character
    Set insert = replace(offset, offset, s)
End Function

Public Function replace(ByVal startPos As Long, ByVal endPos As Long, replacement As String) As ByteStringBuilder
Attribute replace.VB_Description = "Removes a specified range of characters and inserts a new string in their place"
    'Removes the characters from startPos (inclusive) to endPos (exclusive) and inserts replacement at that position
    'If endPos is greater than length, it is treated as length
    'If startPos = endPos, it is effectively the same as insert()
    'If replacement is empty, it is effectively the same as delete()
    
    If startPos < 0 Then Err.Raise 9, "ByteStringBuilder.replace()", "startPos out of bounds: " & startPos
    If startPos > length Then Err.Raise 9, "ByteStringBuilder.replace()", "startPos out of bounds: " & startPos
    If startPos > endPos Then Err.Raise 9, "ByteStringBuilder.replace()", "startPos (" & startPos & ") greater than endPos (" & endPos & ")"
    
    If endPos > length Then endPos = length
    
    startPos = startPos * 2
    endPos = endPos * 2
    
    Dim replacementLen As Long: replacementLen = LenB(replacement)
    Dim newLength As Long
    newLength = totalBytes + replacementLen - (endPos - startPos)
    ensureCapacity newLength * 2
    
    RtlMoveMemory buf(startPos + replacementLen), buf(endPos), totalBytes - endPos
    If replacementLen > 0 Then
        RtlMoveMemory buf(startPos), ByVal StrPtr(replacement), replacementLen
    End If
    
    totalBytes = newLength
    
    Set replace = Me
End Function

Public Property Get lastIndexOf(char As String, Optional fromIndex As Long = 0) As Long
    If fromIndex < 0 Then Err.Raise 9, "ByteStringBuilder.lastIndexOf", "fromIndex out of bounds: " & fromIndex
    If fromIndex >= length Then Err.Raise 9, "ByteStringBuilder.lastIndexOf", "fromIndex out of bounds: " & fromIndex
    Dim i As Long, a As Long
    a = AscW(char)
    For i = length - 1 To fromIndex Step -1
        Dim ii As Integer
        RtlMoveMemory ii, buf(i * 2), 2
        If ii = a Then
            lastIndexOf = i
            Exit Property
        End If
    Next i
    lastIndexOf = -1
End Property

Public Property Get indexOf(char As String, Optional fromIndex As Long = 0) As Long
    If fromIndex < 0 Then Err.Raise 9, "ByteStringBuilder.indexOf", "fromIndex out of bounds: " & fromIndex
    If fromIndex >= length Then Err.Raise 9, "ByteStringBuilder.indexOf", "fromIndex out of bounds: " & fromIndex
    Dim i As Long, a As Long
    a = AscW(char)
    For i = fromIndex To length - 1
        Dim ii As Integer
        RtlMoveMemory ii, buf(i * 2), 2
        If ii = a Then
            indexOf = i
            Exit Property
        End If
    Next i
    indexOf = -1
End Property

Public Function trimToSize() As ByteStringBuilder
    If totalBytes > 0 Then
        ReDim Preserve buf(0 To totalBytes - 1)
        Set trimToSize = Me
    End If
End Function

Public Property Get charAt(pos As Long) As String
Attribute charAt.VB_Description = "Accesses a single character from this object using a 0-based index"
    '0-based
    charAt = vbNullChar
    If pos >= length Or pos < 0 Then Err.Raise 9, "ByteStringBuilder.charAt", "pos out of bounds: " & pos
    RtlMoveMemory ByVal StrPtr(charAt), buf(pos * 2), 2
End Property

Public Property Let charAt(pos As Long, newVal As String)
    If pos >= length Or pos < 0 Then Err.Raise 9, "ByteStringBuilder.charAt", "pos out of bounds: " & pos
    RtlMoveMemory buf(pos * 2), AscW(newVal), 2
End Property

Public Function delete(Optional ByVal startPos As Long = 1, Optional ByVal endPos As Long = -1) As ByteStringBuilder
Attribute delete.VB_Description = "Removes characters from startPos to endPos"
    'Deletes characters from the startPosth character (exclusive) to the endPosth character (inclusive)
    'startPos cannot be less than 1 or greater than endPos
    
    If startPos <= 0 Then
        Err.Raise 9, "ByteStringBuilder.delete()", "startPos out of bounds: " & startPos
    End If
    If startPos > endPos Then
        If endPos > 0 Then
            Err.Raise 9, "ByteStringBuilder.delete()", "startPos (" & startPos & ") greater than endPos (" & endPos & ")"
        End If
    End If

    If endPos <= 0 Then
        endPos = length
    End If

    'Translate character positions into byte positions
    startPos = startPos * 2
    endPos = endPos * 2
    
    If endPos > totalBytes Then
        Err.Raise 9, "ByteStringBuilder.delete()", "endPos out of bounds: " & endPos
    End If
        
    Dim deletedLength As Long
    deletedLength = endPos - startPos
    RtlMoveMemory buf(startPos), buf(endPos), totalBytes - endPos
    totalBytes = totalBytes - deletedLength
    
    Set delete = Me
End Function

Public Property Get maxCapacity() As Long
Attribute maxCapacity.VB_Description = "Theoretical limit to array size"
    'Theoretical limit to array size, in practice it'll claim you ran out of memory before that
    maxCapacity = (2 ^ 31) - 1
End Property

Public Function ensureCapacity(newCapacity As Long) As ByteStringBuilder
Attribute ensureCapacity.VB_Description = "Ensures this object has at least newCapacity bytes"
    'Ensures this object has at least newCapacity bytes
    If newCapacity > totalBytes Then
        ReDim Preserve buf(0 To newCapacity)
    End If
End Function

Public Property Get capacity() As Long
Attribute capacity.VB_Description = "The amount of bytes used by this object's array."
    capacity = UBound(buf) + 1
End Property

Public Property Get length() As Long
    length = totalBytes \ 2
End Property

Public Property Let length(ByVal newVal As Long)
    newVal = newVal * 2
    If newVal < totalBytes Then
        totalBytes = newVal
    ElseIf newVal > totalBytes Then
        ReDim Preserve buf(0 To newVal)
        RtlZeroMemory buf(totalBytes), newVal - totalBytes
        totalBytes = newVal
    End If
End Property

Public Property Get toString(Optional ByVal startIndex As Long = -1, Optional ByVal endIndex As Long = -1) As String
Attribute toString.VB_Description = "Returns the string representation of this object"
Attribute toString.VB_UserMemId = 0
    'No arguments: Returns the whole string
    'startIndex only: Returns a substring starting from startIndex (exclusive) to the end
    'endIndex only: Returns a substring with the first endIndex characters
    'Two arguments: Returns a substring from startIndex (inclusive) to endIndex (exclusive)
    
    If startIndex = -1 Then
        If endIndex = -1 Then
            toString = Space$(length)
            RtlMoveMemory ByVal StrPtr(toString), buf(0), totalBytes
        Else
            toString = Space$(endIndex)
            RtlMoveMemory ByVal StrPtr(toString), buf(0), endIndex * 2
        End If
    Else
        If endIndex = -1 Then endIndex = length
        
        If startIndex > endIndex Then
            Err.Raise 9, "ByteStringBuilder.toString", "startIndex (" & startIndex & ") cannot be greater than endIndex (" & endIndex & ")"
        End If
        If endIndex > length Then
            Err.Raise 9, "ByteStringBuilder.toString", "endIndex (" & endIndex & ") cannot be greater than length (" & length & ")"
        End If
        
        toString = Space$(endIndex - startIndex)
        RtlMoveMemory ByVal StrPtr(toString), buf(startIndex * 2), (endIndex - startIndex) * 2
    End If
End Property

Public Function append(ByVal s As String) As ByteStringBuilder
    If LenB(s) = 0 Then
        Set append = Me
        Exit Function
    End If
    
    Dim b() As Byte, size As Long
    b = s
    size = (UBound(b) - LBound(b)) + 1
    ensureCapacity totalBytes + size
    
    RtlMoveMemory buf(totalBytes), b(0), size
    totalBytes = totalBytes + size
    Erase b
    
    Set append = Me
End Function

Public Function appendLine(ByVal s As String) As ByteStringBuilder
    Set appendLine = append(s).append(vbNewLine)
End Function

Private Sub Class_Initialize()
    ReDim buf(0 To BUF_SIZE)
End Sub

Private Sub Class_Terminate()
    Erase buf
End Sub