In the process of trying to build a serializable data structure, I found myself building large strings, which gets very slow because VBA copies a string every time concatenation is performed.
To alleviate this, referring to Dynamic Array and Java's StringBuilder interface, I cobbled together a unicode clsStringBuilder
class.
This isn't a very big chunk of code, but I'd be interested in any advice about edge cases that I maybe haven't considered, unexpected copying behavior that VBA might be performing "behind my back" which I could avoid, or corrections to coding style (or lack thereof).
Option Compare Database
Option Explicit
'******
'* v2 *
'******
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 = &H10
Private m_currLen As Long
Private m_stringBuffer() As Byte
Private Sub Class_Initialize()
ReDim m_stringBuffer(0 To (DEFAULT_CAPACITY * 2) - 1) 'Each unicode character is 2 bytes
End Sub
Public Function Append(strString As String) As clsStringBuilder
On Error GoTo derp
If m_currLen + LenB(strString) < UBound(m_stringBuffer) Then
CopyMemory VarPtr(m_stringBuffer(m_currLen)), StrPtr(strString), LenB(strString)
Else
If m_currLen + LenB(strString) < UBound(m_stringBuffer) * 2 Then
Expand
Else
Expand m_currLen + LenB(strString)
End If
CopyMemory VarPtr(m_stringBuffer(m_currLen)), StrPtr(strString), LenB(strString)
End If
m_currLen = m_currLen + LenB(strString)
Set Append = Me
Exit Function
derp:
Stop
Resume
End Function
Public Property Get Length() As Long
Length = m_currLen / 2
End Property
Public Property Get Capacity() As Long
Capacity = UBound(m_stringBuffer)
End Property
Private Sub Expand(Optional newSize As Long = 0)
If newSize <> 0 Then
ReDim Preserve m_stringBuffer(0 To newSize - 1)
Else
ReDim Preserve m_stringBuffer(0 To (UBound(m_stringBuffer) * 2) + 1)
End If
End Sub
Public Function toString() As String
toString = Mid(m_stringBuffer, 1, m_currLen / 2)
End Function
Here is a test:
Public Sub Main()
Dim sb As clsStringBuilder
Set sb = New clsStringBuilder
Dim strString As String
Dim i As Long
Dim StartTime As Double
'VBA String
StartTime = MicroTimer()
For i = 0 To 100000
strString = strString + "Hello World;"
Next
Debug.Print "The VBA String took: " & Round(MicroTimer - StartTime, 3) & " seconds"
'StringBuilder
StartTime = MicroTimer()
For i = 0 To 100000
sb.Append "Hello World;"
Next
Debug.Print "The Stringbuilder took: " & Round(MicroTimer - StartTime, 3) & " seconds"
'Are the strings the same?
Debug.Print StrComp(strString, sb.toString, vbBinaryCompare)
End Sub
Here is Microsoft's MicroTimer
function, which can be found here:
Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Function MicroTimer() As Double
'
' Returns seconds.
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0
' Get frequency.
If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
getTickCount cyTicks1
' Seconds
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function