VB6 String Building Class CStringBuilder
My solution to the problem of slow string concatination in VB6 when building huge strings. Here is my CStringBuilder class to speed the job up.
If you try to compile very long strings with VB6 using a loop, you will find that your program gets exponentially slower as it goes through the loop. For example, take the following loop:
For i = 1 To 20000 str = str & "This is a test of concatinating strings in VB6" Next
This is because the whole string is copied, along with the new added bit into a new area of memory. This is extremely inefficient when working with very long strings in examples such as this. The solution to this is to use a byte array in memory and extend the upper bound of the array when concatinating the strings. I have written a class class CStringBuilder to do this which you can find below.
Speed test of the loop above comparing my CStringBuilder class with standard VB6 Strings on my PC:
|Loops||VB6 Strings||My CStringBuilder Class|
|5000||0.2 sec||<0.1 sec|
|10000||3 sec||~0.1 sec|
|15000||8 sec||~0.2 sec|
|20000||18 sec||~0.3 sec|
|25000||32 sec||~0.4 sec|
|30000||49 sec||~0.5 sec|
As you can see, using the built-in VB6 String object is very slow and gets exponentially slower. Using my String Builder class is much quicker.
Here's how to use my CStringBuilder class:
Dim s As New CStringBuilder s.concat "This is how to combine strings. " s.concat "Using my CStringBuilder class. " s.concat "It's very fast!" MsgBox s.text Set s = Nothing
CStringBuilder VB6 Class
Here's the class code. Add a new Class Module in your VB6 project, call it CStringBuilder and paste this code into it.
Option Explicit ' CStringBuilder Class ' ==================== ' String Builder class for VB6 to vastly speed up the concatination ' of large strings ' This will be a 1-based array Dim m_bytes() As Byte Public Sub concat(ByVal s As String) ' 19/01/09 - Concatinate the specified string ' to the string held in this object Dim lOldUbound As Long Dim l As Long On Error GoTo errError1 lOldUbound = UBound(m_bytes) ReDim Preserve m_bytes(0 To lOldUbound + Len(s)) For l = lOldUbound + 1 To lOldUbound + Len(s) m_bytes(l) = Asc(Mid$(s, l - lOldUbound, 1)) Next Exit Sub errError1: Err.Raise Err.Number, , Err.Description End Sub Public Property Get length() As Long ' 19/01/01 - Return the length of the string ' currently held in this object On Error GoTo errError1 ' The array is 1-based so will match the string length length = UBound(m_bytes) Exit Property errError1: Err.Raise Err.Number, , Err.Description End Property Public Property Get text() As String ' 19/01/01 - Return the string held in this ' object On Error GoTo errError1 If Me.length = 0 Then text = "" Else text = Right$(StrConv(m_bytes, vbUnicode), Me.length) End If Exit Property errError1: Err.Raise Err.Number, , Err.Description End Property Private Sub Class_Initialize() ' 19/01/01 - Prepare the array for first use On Error GoTo errError1 Call reset Exit Sub errError1: Err.Raise Err.Number, , Err.Description End Sub Public Sub reset() ' 19/01/01 - Reset the array ready to be used again On Error GoTo errError1 ReDim m_bytes(0) As Byte Exit Sub errError1: Err.Raise Err.Number, , Err.Description End Sub Private Sub Class_Terminate() ' 19/01/01 - Clear up memory used by byte array ' Not really necessary On Error GoTo errError1 Call reset Exit Sub errError1: Err.Raise Err.Number, , Err.Description End Sub