# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  [VB6] StringBuilder - Fast string concatenation

## Dragokas

*v.2.3.*
It's well-tested class for concatenating strings like:


```
s = s & "one line"
s = s & "two line"
...
s = s & "N line"
```

but much much more faster than VB runtime do it.

Cases when it is needed sometimes:
Well, e.g., I'm using it to prepare some really huge logs of program in a single 'String' variable (e.g. up to 1 MB.) rather then writing them line by line to file (for performance acceleration purposes, if debug mode of my app. is disabled).
Don't know what else good cases. Better, don't store large data in this way, use suitable tools: arrays, databases ...

Using examples:


```

Option Explicit

Private Sub Form_Load()
    'init 
    Dim sb As clsStringBuilder
    Set sb = New clsStringBuilder

    'concatenation 
    sb.Append "Very "
    sb.Append "many "
    sb.Append "pieces "
    sb.Append "of data"

    'result 
    Debug.Print "All data: "; sb.ToString
    Debug.Print "Len of data: "; sb.length

    'removing 5 characters from position # 1 
    sb.Remove 1, 5
    Debug.Print "New data: "; sb.ToString

    'inserting string in position # 1 
    sb.Insert 1, "Not "
    Debug.Print "New data: "; sb.ToString

    'overwrite part of the text from position # 1 (same like MID(str,x) = "...") 
    sb.Overwrite 1, "How"
    Debug.Print "New data: "; sb.ToString

    'getting 2 first characters 
    Debug.Print "2 left chars: "; sb.ToStringLeft(2)

    'getting 2 characters from the end 
    Debug.Print "2 end chars: "; sb.ToStringRight(2)

    'getting 2 characters from the middle, beginning from position 6 
    Debug.Print "2 middle chars: "; sb.ToStringMid(6, 2)

    'getting a pointer to a NUL terminated string to use somehow (e.g. write on disk by ptr, WriteFile, e.t.c.) 
    'this method is much faster than .ToString() 
    'warning: you should use this pointer before calling next any method of StringBuilder, that may cause changing its data 
    Debug.Print "ptr to string: "; sb.ToStringPtr

    'replacing the data (same as Clear + Append) 
    sb.StringData = "Anew"
    Debug.Print "New data: "; sb.ToString

    'go to the next line (append CrLf) 
    sb.AppendLine ""
    'append second line with CrLf at the end 
    sb.AppendLine "Second line"
    'append third line without CrLf 
    sb.Append "Third Line"

    Debug.Print sb.ToString

    'clear all data 
    sb.Clear
    Debug.Print "Len of data (after clear): "; sb.length

    'Search samples (by default search is case sensitive) 
    'Set new data 
    sb.StringData = "|textile|Some|text|to|search"
    Debug.Print "New data: "; sb.ToString

    'Simple search ('text' will be found inside 'textile' word) 
    Debug.Print "Position of 'text': " & sb.Find(1, "text")

    'Simple search (start search from position 3) 
    Debug.Print "Position of 'text': " & sb.Find(3, "text")

    Debug.Print "'some' (case sensitive): " & sb.Find(1, "some")
    Debug.Print "'some' (case insensitive): " & sb.Find(1, "some", , vbTextCompare)

    'Search by delimiter 
    Debug.Print "searching for |text|: " & sb.Find(1, "text", "|")

    'Search for empty string, saved with delimiter | 
    Debug.Print "empty string (delim = '|'): " & sb.Find(1, "", "|")

    'Undo operations 
    sb.StringData = "Some data "
    Debug.Print "Orig. string: " & sb.ToString

    sb.Append "remove"
    Debug.Print "After Append: " & sb.ToString
    'or you can use .UndoAppend 
    sb.Undo
    Debug.Print "After Undo:   " & sb.ToString

    sb.Insert 6, "bad "
    Debug.Print "After Insert: " & sb.ToString
    'or you can use .UndoInsert 
    sb.Undo
    Debug.Print "After Undo:   " & sb.ToString

    sb.Overwrite 1, "Here"
    Debug.Print "After Overwrite: " & sb.ToString
    'or you can use .UndoOverwrite 
    sb.Undo
    Debug.Print "After Undo:      " & sb.ToString

    sb.Remove 2, 5
    Debug.Print "After Remove: " & sb.ToString
    'or you can use .UndoRemove 
    sb.Undo
    Debug.Print "After Undo:   " & sb.ToString

    'when you finished work with the class 
    Set sb = Nothing

    Unload Me
End Sub


```

Result:



> All data: Very many pieces of data
> Len of data:  24 
> New data: many pieces of data
> New data: Not many pieces of data
> New data: How many pieces of data
> 2 left chars: Ho
> 2 end chars: ta
> 2 middle chars: an
> ptr to string:  228655136 
> ...


Copyrights: VolteFace (Fork by Dragokas)

----------


## dreammanor

Very useful source code, thanks for sharing. If the *Find* function could be added to this class, that would be great.



```
Public Function Find(ByRef str As String, Optional ByVal delimiter As String) As Long

End Function
```

Edit:  
I missed three parameters in the Find function, now correct as follows



```

Public Function Find(ByRef str As String, ByVal destination As String, Optional ByVal start As long = 1, Optional ByVal compare As VbCompareMethod = vbBinaryCompare, Optional ByVal delimiter As String = vbNullString) As Long

End Function
```

----------


## Dragokas

Hi, dreammanor!
Thanks for the suggestion. I'll see what I can do.
However, what is mean under "delimiter" for the search text ?

I must warn that for unknown reason this code sometimes crash the program on class destruction in this line:


```
HeapFree GetProcessHeap, 0&, m_pMemoryPtr
```

Further I added some safely checkings:


```
Private Sub Class_Terminate()
    Dim hProcHeap As Long
    ' If we have memory allocated, free it
    If m_pMemoryPtr <> 0 Then
        hProcHeap = GetProcessHeap()
        If hProcHeap <> 0 Then
            If HeapValidate(hProcHeap, 0&, m_pMemoryPtr) Then
                '//TODO
                'disabled until I figure out why it sometimes crash the program in /silentautolog mode
                'HeapFree hProcHeap, 0&, m_pMemoryPtr
            End If
        End If
    End If
End Sub
```

But, it still crash on the same line.
I unable to resolve this.
I still not sure, maybe it is caused by error in another part of my project that can overwrite by mistake a memory region used by this class.

Because, I don't want give up this class, finally, I commented freeing the resource. It's of course lead to memory leak, but do not crash anymore.
If anyone has ideas, I glad to see.

----------


## dreammanor

> However, what is mean under "delimiter" for the search text ?


Sorry, I missed three parameters in the Find function. Now correct as follows:



```

Public Function Find(ByRef str As String, ByVal destination As String, Optional ByVal start As long = 1, Optional ByVal compare As VbCompareMethod = vbBinaryCompare, Optional ByVal delimiter As String = vbNullString) As Long

End Function
```

The meaning of delimiter is similar to the join and split functions:
        Join (Sourcearray, Delimiter)
        Split (Expression, Delimiter)

Many people often need to use the delimiter when working with strings, for example:
        sItemList = sItem1 & vbTab & sItem2 & vbTab & sItem3 & vbTab ...
        or:
        sItemList = sItem1 & "|" & sItem2 & "|" & sItem3 & "|" ...
        or:
        sItemList = sItem1 & ";" & sItem2 & ";" & sItem3 & ";" ...

The logic of the Find function is as follows: (*Edit: the logic of Find function is incorrect*)



```

Public Function Find(ByRef str As String, ByVal destination As String, _
                            Optional ByVal start As Long = 1, _
                            Optional ByVal compare As VbCompareMethod = vbBinaryCompare, _
                            Optional ByVal delimiter As String = vbNullString) As Long
    If start <= 0 Then start = 1
    
    If destination = vbNullString Then
        Exit Function
    ElseIf delimiter = vbNullString Then
        Find = InStr(start, str, destination, compare)
        Exit Function
    End If
    
    '--------------------------------------------------------------------------
    '--- Processing the delimiter:
    '--------------------------------------------------------------------------
    
    Dim length As Long, position As Long
    
    length = Len(destination)
    
    If Left(str, length + 1) = destination & delimiter Then
        If start = 1 Then
            position = 1
        End If
    ElseIf Right(str, length + 1) = delimiter & destination Then
        position = Len(str) - length + 1
        If position < start Then
            position = 0
        End If
    Else
        position = InStr(start, str, delimiter & destination & delimiter, compare)
    End If
    
    Find = position
    
End Function
```

----------


## dreammanor

Very sorry, the above logic of Find function is incorrect and now correct as follows:



```
Public Function Find(ByRef str As String, ByVal destination As String, _
                            Optional ByVal start As Long = 1, _
                            Optional ByVal compare As VbCompareMethod = vbBinaryCompare, _
                            Optional ByVal delimiter As String = vbNullString) As Long
    If start <= 0 Then start = 1
    
    If destination = vbNullString Then
        Exit Function
    ElseIf delimiter = vbNullString Then
        Find = InStr(start, str, destination, compare)
        Exit Function
    End If
    
    '--------------------------------------------------------------------------
    '--- Processing the delimiter:
    '--------------------------------------------------------------------------
    
    Dim length As Long, position As Long
    
    If start = 1 And Left(str, length + 1) = destination & delimiter Then
        position = 1
    Else
        position = InStr(start, str, delimiter & destination & delimiter, compare)
        If position = 0 Then
            If Right(str, length + 1) = delimiter & destination Then
                position = Len(str) - length + 1
                If position < start Then
                    position = 0
                End If
            End If
        End If
    End If
    
    Find = position
    
End Function
```

*Or*



```

Public Function Find(ByRef str As String, ByVal destination As String, _
                            Optional ByVal start As Long = 1, _
                            Optional ByVal compare As VbCompareMethod = vbBinaryCompare, _
                            Optional ByVal delimiter As String = vbNullString) As Long
    
    If destination <> vbNullString Then
        If start <= 0 Then start = 1
        If delimiter = vbNullString Then
            Find = InStr(start, str, destination, compare)
        Else
            Find = InStr(start, delimiter & str & delimiter, delimiter & destination & delimiter, compare)
        End If
    End If
        
End Function
```

----------


## Dragokas

Understood.
I am using something similar in my programs:


```
Public Function inArraySerialized( _
    Stri As String, _
    SerializedArray As String, _
    Delimiter As String, _
    Optional lB As Long = -2147483647, _
    Optional uB As Long = 2147483647, _
    Optional CompareMethod As VbCompareMethod) As Boolean
    
    On Error GoTo ErrorHandler:
    Dim MyArray() As String
    If 0 = Len(SerializedArray) Then
        If 0 = Len(Stri) Then inArraySerialized = True
        Exit Function
    End If
    MyArray = Split(SerializedArray, Delimiter)
    If lB = -2147483647 Or lB < LBound(MyArray) Then lB = LBound(MyArray)  'some trick
    If uB = 2147483647 Or uB > UBound(MyArray) Then uB = UBound(MyArray)  'Thanks to Казанский :)
    
    Dim i As Long
    For i = lB To uB
        If StrComp(Stri, MyArray(i), CompareMethod) = 0 Then inArraySerialized = True: Exit For
    Next
    Exit Function
ErrorHandler:
    ErrorMsg Err, "inArraySerialized", "SerializedString: ", SerializedArray, "delim: ", Delimiter
    If inIDE Then Stop: Resume Next
End Function
```

But it is not suitable for in-memory search, like C++ strstr(), and not intended for searching within a large amount of data like StringBuilder holds.
So, I need to build own replacement for that, or to get a ready solution if someone already have a code for the fast text search by pointers.

----------


## Tanner_H

Hi Dragokas.  Your crash in HeapFree is caused by a bad API declaration.  Change the declaration to "ByVal lpMem as Long", or explicitly pass m_pMemoryPtr as ByVal.  (Honestly, the class has quite a few issues like this - to avoid other problems, you could change many of its API declarations to ByVal Long instead of ByRef Any, then remove all the hard-coded ByVal statements in function calls.)

Also, shlwapi exports a StrStr wrapper: 

https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

I use it (and StrStrI) for searching pointer-based strings.  Shlwapi exports many other C string functions if you need them.

----------


## Dragokas

Tanner_H, oh my god, I checked everything, except API declaration. Thanks for the point.



> shlwapi exports a StrStr wrapper


Very nice. Thanks again  :Smilie:

----------


## Dragokas

For the search purposes: because StrStr() returns a pointer, is there a way to guarantee that HeapReAlloc() function will return continous block of memory?
Use HEAP_REALLOC_IN_PLACE_ONLY flag? And if it fails -> make call to HeapAlloc, sacrificing the speed. Am I right? Or there is a better way?

I also worried about heap fragmentation in HeapAlloc. However, MSDN say:



> The system does not use the LFH for allocations larger than 16 KB


and my class has Chunk of 1 MB, so it is not my case.

----------


## Tanner_H

No problem Dragokas, I'm glad it was quick to fix!   :Smilie: 

HeapAlloc always allocates contiguous blocks of memory, so that shouldn't be a concern.  HEAP_REALLOC_IN_PLACE_ONLY just means that re-allocations are not allowed to move the memory somewhere new (which is usually required, since free memory may not exist immediately following the current allocation).  You definitely don't want that flag for a string builder.

To be honest, there's not really a benefit to using HeapAlloc directly for memory allocation in VB6.  Unless an API specifically requires heap handles, you can just use standard VB arrays for the same result.  This would greatly simplify the class if you don't mind the work.  (Of course, at that point, you have basically rewritten the entire class as your own!)

----------


## wqweto

VB6 poor man's string builder is just a glorified collection w/ a single concat function like this

vb Code:
Option Explicit Public Function ConcatCollection(oCol As Collection, Optional Separator As String) As String    Dim lSize           As Long    Dim vElem           As Variant        For Each vElem In oCol        lSize = lSize + Len(vElem) + Len(Separator)    Next    If lSize > 0 Then        ConcatCollection = String$(lSize - Len(Separator), 0)        lSize = 1        For Each vElem In oCol            If lSize <= Len(ConcatCollection) Then                Mid$(ConcatCollection, lSize, Len(vElem) + Len(Separator)) = vElem & Separator            End If            lSize = lSize + Len(vElem) + Len(Separator)        Next    End IfEnd Function Private Sub Form_Load()    Dim sb As Collection        Set sb = New Collection    sb.Add "Very "    sb.Add "many "    sb.Add "pieces "    sb.Add "of data"    Debug.Print "All data: "; ConcatCollection(sb)    sb.Remove 1    sb.Add "Not ", Before:=1    Debug.Print "New data: "; ConcatCollection(sb)    sb.Remove 1    sb.Add "How ", Before:=1    Debug.Print "New data: "; ConcatCollection(sb)    Set sb = New Collection    sb.Add "Anew"    Debug.Print "New data: "; ConcatCollection(sb)End Sub

Original `clsStringBuilder` has another nice feature though -- it prevents COM string's heap exhaustion by keeping the chunk of memory in a separate heap.

cheers,
</wqw>

----------


## DEXWERX

@wqewto I always thought that this was how the .NET stringbuilder works (1 big chain), but my notes say otherwise. 
i could have sworn .NET just collects / chains each string, and then concat's them all at once. *shrugs*

----------


## Tanner_H

> @wqewto I always thought that this was how the .NET stringbuilder works (1 big chain), but my notes say otherwise. 
> i could have sworn .NET just collects / chains each string, and then concat's them all at once. *shrugs*


Good memory, Dex.  That's still how the version on GitHub works, anyway:

https://github.com/dotnet/coreclr/bl...ringBuilder.cs




> // A StringBuilder is internally represented as a linked list of blocks each of which holds
>         // a chunk of the string.  It turns out string as a whole can also be represented as just a chunk, 
>         // so that is what we do.


Sample of their ToString() implementation:



```
                    do
                    {
                        if (chunk.m_ChunkLength > 0)
                        {
                            // Copy these into local variables so that they are stable even in the presence of race conditions
                            char[] sourceArray = chunk.m_ChunkChars;
                            int chunkOffset = chunk.m_ChunkOffset;
                            int chunkLength = chunk.m_ChunkLength;

                            // Check that we will not overrun our boundaries. 
                            if ((uint)(chunkLength + chunkOffset) <= (uint)result.Length && (uint)chunkLength <= (uint)sourceArray.Length)
                            {
                                fixed (char* sourcePtr = &sourceArray[0])
                                    string.wstrcpy(destinationPtr + chunkOffset, sourcePtr, chunkLength);
                            }
                            else
                            {
                                throw new ArgumentOutOfRangeException(nameof(chunkLength), SR.ArgumentOutOfRange_Index);
                            }
                        }
                        chunk = chunk.m_ChunkPrevious;
                    }
                    while (chunk != null);
```

----------


## DEXWERX

ah nice, thanks for digging that up.

so it walks the chain backwards. neat.

----------


## dreammanor

If the C# StringBuilder is much faster than VB string processing, it may be a good choice to rewrite a VB StringBuilder based on the C# StringBuilder. I know someone has changed the partial dotNet library to the VB framework, unfortunately that framework doesn't include the StringBuilder class.

http://www.planet-source-code.com/vb...74585&lngWId=1

----------


## wqweto

@dreammanor: VBCorLib seems to be of much higher quality codewise *and* includes a StringBuilder implementation.

cheers,
</wqw>

----------


## dreammanor

Yes, wqweto, I just searched this library a few minutes ago, but the link you provided is more valuable, thank you very much!

http://www.planet-source-code.com/vb...66874&lngWId=1

----------


## Dragokas

Updated to v2.0

WARNING: meaning of prototypes is changed to meet VB6 friendly convention: "Index" is replaced by "pos" (position), where "pos" is start from 1 (for "Index" it was 0).

Changelog:
'   Full revision
'   .Find          method has been added (by dreammanor's request).
'   .ToStringPtr   method has been added.
'   .ToStringLeft  method has been added.
'   .ToStringMid   method has been added.
'   .ToStringRight method has been added.
'   .ToString method replaced by 2x faster version (PutMem4 + SysAllocString) (thanks to Bonnie West).
'   .Clear method is improved in speed (removed RtlZeroMemory).
'   Finally, fixed the crash with HeapFree and respectively a memory leak (wrong declaration) (thanks to Tanner_H).
'   A bit faster memory allocation (removed HEAP_ZERO_MEMORY).
'   A bit faster working with heap (creating new heap instead of using default process heap + HEAP_NO_SERIALIZE).
'   Fixed some formulas on reallocation calculations.
'   Added some safe checkings.

Examples of using are updated.

Descriptions of new methods:

' #############################
'
'   .Find
'
'   Returns a position to the first occurrence of search string, or 0 if does not occur.
'
' #############################

Find(StartPos As Long, StrSearch As String, Optional Delimiter As String, Optional CompareMethod As VbCompareMethod) As Long

If delimiter is specified, search will be performed inside the delimiters, like regexp:
        'stady 1: search ^string$
        'stady 2: search ^string|$
        'stady 3: search .*|string|.*
        'stady 4: search .*|string$

' #############################
'
'   .ToStringPtr
'
'   Get the pointer to string (much faster than using .ToString).
'
'   Note 1: Use .Length method to know the size of this string.
'   Note 2: This pointer should be used before next calling to .Append / .Insert / .Overwrite / .StringData methods.
'   Note 3: Application should not manually free this pointer.
'   Note 4: Class guarantee the returned pointer contains the string with two NUL terminators.
'
' #############################

.ToStringLeft / .ToStringMid / .ToStringRight

Get the copy of internally stored string (only the some part)

it's a bit faster analogue of:

Left$(.ToString, length)
Mid$(.ToString, pos, length)
Right$(.ToString, length)

' #############################

----------


## dreammanor

Hi Dragokas, I've tested your StringBuilder and it makes a function of my program almost three times faster. Thank you so much.

----------


## Dragokas

Glad to see. You are welcome.

----------


## jpbro

Nice work! I've tested it a bit and it is about 2x faster than my existing StringBuilder.

One thing I have need for is the ability to undo the most recent Append call. It's a convenience for simpler code when building strings where I don't necessarily know how many appends I'll need, or I don't want the extra code to check if I'm on the last item.

For example, when building an SQL string I might need a list of field names all separated by commas except for the last field. In this case, the following:



```
For ii = 1 to Fields.Count
   sb.Append Fields(ii).Name
   sb.Append ", "
Next ii
sb.UndoLastAppend
```

Looks nicer to me then the following:



```
For ii = 1 to Fields.Count
  sb.Append Fields(ii).Name
  if ii < Fields.Count Then sb.Append ", "
Next ii
```

I admit that's probably a matter of taste, but if you have any interest in including such a feature in your string builder, I've added it in the following code:



```
Option Explicit

' ****************************************************
'
'   cStringBuilder
'   By VolteFace
'
'   Date Created: 3/21/2004
'
'   This class was created to provide more or less the
'   same functionality as the System.Text.StringBuider
'   class available in the .NET framework. It makes use
'   of direct memory allocation and manipulation, so is
'   much faster than traditional VB string concatenation.
'
'   **************************************************
'
'   Fork by Alex Dragokas
'
'   v2.0 (15.11.2017)
'
'   Full revision
'   .Find          method has been added (by dreammanor's request).
'   .ToStringPtr   method has been added.
'   .ToStringLeft  method has been added.
'   .ToStringMid   method has been added.
'   .ToStringRight method has been added.
'   .ToString method replaced by 2x faster version (PutMem4 + SysAllocString) (thanks to Bonnie West).
'   .Clear method is improved in speed (removed RtlZeroMemory).
'   Finally, fixed the crash with HeapFree and respectively a memory leak (wrong declaration) (thanks to Tanner_H).
'   A bit faster memory allocation (removed HEAP_ZERO_MEMORY).
'   A bit faster working with heap (creating new heap instead of using default process heap + HEAP_NO_SERIALIZE).
'   Fixed some formulas on reallocation calculations.
'   Added some safe checkings.
'
'   v1.3 (13.05.2017)
'
'   Added heap validation before freeing to prevent application crash, just in case it is corrupted somehow.
'
'   v1.2 (12.07.2015)
'
'   Fixed bug: .ToString method returns stripped string, if it contains NUL characters
'
'   v1.1 (10.07.2015)
'
'   Some methods renamed
'   Changed pointer type for all methods - "byval" to "byref"
'   Fixed bug: wrong buffer size defined during reallocation in .Append method which cause application crash
'
' ****************************************************

' ############################# TYPE DECLARES
Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    wProcessorLevel As Integer
    wProcessorRevision As Integer
End Type

' ############################# API DECLARES
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExW" (lpVersionInformation As Any) As Long
Private Declare Sub GetSystemInfo Lib "kernel32.dll" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function HeapCreate Lib "kernel32.dll" (ByVal flOptions As Long, ByVal dwInitialSize As Long, ByVal dwMaximumSize As Long) As Long
Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapReAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
Private Declare Function HeapDestroy Lib "kernel32.dll" (ByVal hHeap As Long) As Long
Private Declare Function HeapValidate Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
'Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
'Private Declare Sub RtlZeroMemory Lib "kernel32.dll" (Destination As Any, ByVal length As Long)
Private Declare Function memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long) As Long
Private Declare Function GetMem2 Lib "msvbvm60.dll" (Src As Any, Dst As Any) As Long
Private Declare Function PutMem4 Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewVal As Long) As Long
Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal pOlechar As Long) As Long
Private Declare Function StrStrW Lib "Shlwapi.dll" (ByVal pszFirst As Long, ByVal pszSrch As Long) As Long
Private Declare Function StrStrIW Lib "Shlwapi.dll" (ByVal pszFirst As Long, ByVal pszSrch As Long) As Long
Private Declare Function CompareStringOrdinal Lib "kernel32.dll" (ByVal lpString1 As Long, ByVal cchCount1 As Long, ByVal lpString2 As Long, ByVal cchCount2 As Long, ByVal bIgnoreCase As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcmpW Lib "kernel32.dll" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function lstrcmpiW Lib "kernel32.dll" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

' ############################# CONSTANTS
Private Const CHUNK_SIZE            As Long = 1048576 'each (re)allocation == 1 MB by default.
Private Const HEAP_NO_SERIALIZE     As Long = 1&
Private Const HEAP_ZERO_MEMORY      As Long = &H8&
Private Const CSTR_EQUAL            As Long = 2&

' ############################# MEMBER VARIABLES
Private m_pMemoryPtr         As Long
Private m_lAllocSize         As Long
Private m_lChunkLength       As Long
Private m_lLength            As Long
Private m_lLengthUndoAppend        As Long
Private m_hHeap              As Long
Private m_Chunk_Size_Aligned As Long
Private m_bIsVistaAndNewer   As Boolean

' #############################
'
'   Class_Initialize
'
'   Initializes the class, creates new heap
'   and allocates the initial string buffer.
'
' #############################
Private Sub Class_Initialize()
    Dim inf(68)     As Long
    Dim MajorMinor  As Single
    Dim si          As SYSTEM_INFO
    
    GetSystemInfo si
    
    If si.dwPageSize = 0 Then
        Debug.Print "Error in retrieving page size. GetSystemInfo failed with 0x" & Hex(Err.LastDllError)
        Err.Raise 5, , "Cannot obtain page size"
        Exit Sub
    End If
    
    inf(0) = 276
    GetVersionEx inf(0)
    MajorMinor = inf(1) + inf(2) / 10
    m_bIsVistaAndNewer = (MajorMinor >= 6)
    
    'align chunk to the upper bound of the page size
    m_Chunk_Size_Aligned = AlignUp(CHUNK_SIZE, si.dwPageSize)
    
    m_hHeap = HeapCreate(HEAP_NO_SERIALIZE, m_Chunk_Size_Aligned, 0&)
    If m_hHeap = 0 Then
        Debug.Print "HeapCreate failed with 0x" & Hex(Err.LastDllError)
        Err.Raise 5, , "Cannot create new heap"
        Exit Sub
    End If
    
    ' Allocate default chunk size
    Allocate m_Chunk_Size_Aligned
End Sub

'Align number to the upper bound
Private Function AlignUp(Num As Long, Align As Long) As Long
    AlignUp = (Num \ Align) * Align
    If AlignUp < Num Then
        AlignUp = AlignUp + Align
    End If
End Function

' #############################
'
'   Allocate
'
'   Allocates a specified amount of memory
'   for the string buffer.
'
' #############################
Private Sub Allocate(Size As Long)
    Dim tmp As Long
    Dim newSize As Long
    
    ' If no memory is allocated yet, allocate some from the heap - otherwise
    ' reallocate (resize) the block that has already been allocated
    If m_pMemoryPtr = 0 Then
        m_pMemoryPtr = HeapAlloc(m_hHeap, HEAP_NO_SERIALIZE, Size)
    Else
        m_pMemoryPtr = HeapReAlloc(m_hHeap, HEAP_NO_SERIALIZE, m_pMemoryPtr, Size)
    End If
    
    m_lAllocSize = Size
End Sub

' #############################
'
'   .ToString
'
'   Get the copy of internally stored string
'
' #############################
Public Property Get ToString() As String
    If m_lLength = 0 Then Exit Property
    PutMem4 VarPtr(ToString), SysAllocString(m_pMemoryPtr)
End Property

' #############################
'
'   .StringData
'
'   Set the new string by clearing all stored data
'
' #############################
Public Property Let StringData(str As String)
    Clear
    Append str
End Property


' #############################
'
'   .ToStringPtr
'
'   Get the pointer to string (much faster than using .ToString).
'
'   Note 1: Use .Length method to know the size of this string.
'   Note 2: This pointer should be used before next calling to .Append / .Insert / .Overwrite / .StringData methods.
'   Note 3: Application should not manually free this pointer.
'   Note 4: Class guarantee the returned pointer contains the string with two NUL terminators.
'
' #############################
Public Property Get ToStringPtr() As Long
    If m_lLength = 0 Then Exit Property
    ToStringPtr = m_pMemoryPtr
End Property


' #############################
'
'   .ToStringLeft
'
'   Get the copy of internally stored string (only the part from beginning of the string)
'
' #############################
Public Property Get ToStringLeft(ByVal length As Long) As String
    If m_lLength = 0 Then Exit Property
    If length > (m_lLength \ 2) Then
        length = m_lLength \ 2
    End If
    ToStringLeft = String$(length, 0&)
    memcpy ByVal StrPtr(ToStringLeft), ByVal m_pMemoryPtr, length * 2
End Property


' #############################
'
'   .ToStringMid
'
'   Get the copy of internally stored string (only the part from middle of the string)
'
' #############################
Public Property Get ToStringMid(StartPos As Long, ByVal length As Long) As String
    Dim Index As Long
    Index = StartPos - 1
    If m_lLength = 0 Then Exit Property
    If StartPos > (m_lLength \ 2) Then Exit Property
    If Index + length > (m_lLength \ 2) Then
        length = (m_lLength \ 2) - Index
    End If
    ToStringMid = String$(length, 0&)
    memcpy ByVal StrPtr(ToStringMid), ByVal m_pMemoryPtr + Index * 2, length * 2
End Property


' #############################
'
'   .ToStringRight
'
'   Get the copy of internally stored string (only the part from end of the string)
'
' #############################
Public Property Get ToStringRight(ByVal length As Long) As String
    If m_lLength = 0 Then Exit Property
    If length > (m_lLength \ 2) Then
        length = m_lLength \ 2
    End If
    PutMem4 VarPtr(ToStringRight), SysAllocString(m_pMemoryPtr + m_lLength - length * 2)
End Property


' #############################
'
'   .Clear
'
'   Removes all string data from the
'   initial string buffer, and resizes
'   the buffer down to the initial 1MB.
'
' #############################
Public Sub Clear()
    ' Clean out the string buffer
    m_lLengthUndoAppendAppend = 0
    If m_lLength <> 0 Then
        m_lLength = 0
        Allocate m_Chunk_Size_Aligned
    End If
End Sub

' #############################
'
'   .Append
'
'   Adds a specified string on to the
'   end of the string stored in the
'   buffer.
'
' #############################
Public Sub Append(str As String)
    Dim pTo As Long
    
    ' If we are going to need more memory (if the final size of the append is going to be
    ' greater than the currently allocated size), we need to find out how much more we
    ' need (in increments of CHUNK_SIZE, default 1MB) and allocate it
    ' +2 to hold NUL terminator
    m_lLengthUndoAppend = m_lLength
    
    If m_lLength + LenB(str) + 2 > m_lAllocSize Then
        Allocate AlignUp(m_lLength + LenB(str) + 2, m_Chunk_Size_Aligned)
    End If
    
    ' Put the specified string at the end of the string buffer
    pTo = m_pMemoryPtr + m_lLength
    memcpy ByVal pTo, ByVal StrPtr(str), LenB(str) + 2 '+2 for NUL terminator
    
    m_lLength = m_lLength + LenB(str)
End Sub

' #############################
'
'   .Insert
'
'   Inserts a specified string into the
'   stored string at a specific index.
'
' #############################
Public Sub Insert(pos As Long, str As String)
    Dim pFrom As Long
    Dim pTo As Long
    Dim Index As Long
    
    Index = pos - 1
    If Len(str) = 0 Then Exit Sub
    If (Index < 0) Then Exit Sub
    If (Index > (m_lLength \ 2)) Then Exit Sub
    
    ' If we are going to need more memory (if the final size of the insert is going to be
    ' greater than the currently allocated size), we need to find out how much more we
    ' need (in increments of CHUNK_SIZE, default 1MB) and allocate it
    ' +2 to consider 2 NUL characters as terminator
    If m_lLength + LenB(str) + 2 > m_lAllocSize Then
        Allocate AlignUp(m_lLength + LenB(str) + 2, m_Chunk_Size_Aligned)
    End If
    
    ' Copy the entire stored string, from 'index' to the end and move it over to the
    ' right to accomodate for the new string to be inserted, and then put the specified
    ' string in the correct position
    
    ' str = 'NEW ' (Len = 4)
    '         v
    ' INITIAL STRING FOR TEST
    ' |       |   |         |
    ' |       |   |         m_lLength
    ' |       |   |
    ' |       |   pTo
    ' |       |
    ' |       pFrom (Index)
    ' |
    ' m_pMemoryPtr
    
    pFrom = m_pMemoryPtr + (Index * 2&)
    pTo = pFrom + LenB(str)
    
    memcpy ByVal pTo, ByVal pFrom, m_lLength - (Index * 2&) + 2 '+2 - include NUL terminator
    memcpy ByVal pFrom, ByVal StrPtr(str), LenB(str)
    
    m_lLength = m_lLength + LenB(str)
    m_lLengthUndoAppend = m_lLength ' Obliterate Undo Append position tracker
End Sub

' #############################
'
'   .Overwrite
'
'   Inserts a string into the middle
'   of the stored string, wiping out
'   the characters at that position.
'
' #############################
Public Sub Overwrite(pos As Long, str As String)
    Dim pFrom As Long
    Dim pTo As Long
    Dim Index As Long
    Dim bExpanded As Boolean
    
    Index = pos - 1
    If Len(str) = 0 Then Exit Sub
    If (Index < 0) Then Exit Sub
    If (Index > (m_lLength \ 2)) Then Exit Sub
    
    ' If we are going to need more memory (if the inserted string goes over
    ' the length of the current string, and ends up being longer than the allocated
    ' memory block, we need to calculate how much we need (in increments of CHUNK_SIZE,
    ' default 1MB) and allocate it
    ' +2 to consider 2 NUL characters as terminator
    If Index * 2 + LenB(str) + 2 > m_lAllocSize Then
        Allocate AlignUp(m_lLength + LenB(str) + 2, m_Chunk_Size_Aligned)
    End If
    
    ' str = 'OVER'
    '        v
    ' STRING HERE FOR TEST
    ' |      |           |
    ' |      |           m_lLength
    ' |      |
    ' |      pFrom (Index)
    ' |
    ' m_pMemoryPtr
     
    ' Copy the specified string into the stored string
    pFrom = m_pMemoryPtr + (Index * 2&)
    
    memcpy ByVal pFrom, ByVal StrPtr(str), LenB(str)
    
    ' If the string got longer (the inserted string hung over the end of the
    ' old string) we need to calculate how much bigger it got
    ' and append NUL terminator
    If (Index * 2&) + LenB(str) > m_lLength Then
        m_lLength = Index * 2& + LenB(str)
        GetMem2 ByVal StrPtr(vbNullChar), ByVal (m_pMemoryPtr + m_lLength)
    End If

    m_lLengthUndoAppend = m_lLength ' Obliterate Undo Append position tracker
End Sub

' #############################
'
'   .Remove
'
'   Removes text from the middle of
'   the stored string.
'
' #############################
Public Sub Remove(pos As Long, ByVal length As Long)
    Dim pFrom As Long
    Dim pTo As Long
    Dim Index As Long
    
    Index = pos - 1
    If (length <= 0) Then Exit Sub
    If (Index < 0) Then Exit Sub
    If (Index > (m_lLength \ 2)) Then Exit Sub
    
    ' Copy the entire stored string, from 'index' to the end and move it over to the
    ' left to overright the desired chracters, and then excess characters at the end
    ' of the string
    If (length + Index > (m_lLength \ 2)) Then
        length = (m_lLength \ 2) - Index
    End If
    
    ' GOOD GARBAGE STRING
    ' |    |       |    |
    ' |    |       |    |
    ' |    |       |    m_lLength
    ' |    |       |
    ' |    |       pFrom
    ' |    |
    ' |    pTo (Index)
    ' |
    ' m_pMemoryPtr
    
    pTo = m_pMemoryPtr + (Index * 2&)
    pFrom = m_pMemoryPtr + ((Index + length) * 2&)
    
    memcpy ByVal pTo, ByVal pFrom, m_lLength - ((Index + length) * 2&)
        
    m_lLength = m_lLength - (length * 2&)
    
    'Append NUL terminator
    GetMem2 ByVal StrPtr(vbNullChar), ByVal (m_pMemoryPtr + m_lLength)

    m_lLengthUndoAppend = m_lLength ' Obliterate Undo Append position tracker
End Sub

' #############################
'
'   .Length
'
'   Returns the length of the string
'
' #############################
Public Property Get length() As Long
    ' Since the string is stored as unicode, every character is 2 bytes
    length = m_lLength \ 2
End Property

' #############################
'
'   .UndoAppend
'
'   Undo the last append.
'   Must be called before any intervening Insert, Overwrite, Remove calls
'
' #############################
Public Sub UndoAppend()
   If m_lLength <> m_lLengthUndoAppend Then
      m_lLength = m_lLengthUndoAppend
      
      GetMem2 ByVal StrPtr(vbNullChar), ByVal (m_pMemoryPtr + m_lLength)
   
   Else
      ' Nothing to undo!
      Debug.Assert False
      
   End If
End Sub

' #############################
'
'   .Find
'
'   Returns a position to the first occurrence of search string, or 0 if does not occur.
'
' #############################
Public Property Get Find(StartPos As Long, StrSearch As String, Optional Delimiter As String, Optional CompareMethod As VbCompareMethod) As Long
    ' StartPos - what position the searching must be started from
    ' StrSearch - what string to search for
    ' Delimiter - if strings in StringBuilder are delimited by some character(s),
    '   e.g. if .Find 'rose' in '|melrose|rose|' should return pos. == 10, not 5
    ' CompareMethod - case sensitive mode switch
    
    Dim Index As Long
    
    Index = StartPos - 1
    
    If Index > m_lLength \ 2 Then Exit Property
    
    'if Search string is empty
    If Len(StrSearch) = 0 Then
        If Len(Delimiter) = 0 Then '1. Search == "" + no Delim -> return pos == 1
            Find = 1
        Else                       '2. Search == "" + some Delim -> search for empty value, surrounded by Delim
            'stady 1: if empty data -> false
            'stady 2: if ^|.*
            'stady 3: if .*||.*
            'stady 4: if .*|$
            'for 2,3,4: returns a position next to the delimiter, even if it is exceed the size of StringBuilder's data
            
            '1
            If m_lLength = 0 Then  'no records yet -> no matches
                Find = 0
            Else
                '2
                If StartPos = 1 Then
                    If m_lLength \ 2 >= Len(Delimiter) Then
                        If StrComp(ToStringLeft(Len(Delimiter)), Delimiter, CompareMethod) = 0 Then
                            Find = 1
                            Exit Property
                        End If
                    End If
                End If
                
                '3
                Find = InstrPtr(StartPos, StrPtr(Delimiter & Delimiter), m_pMemoryPtr, CompareMethod)
                If Find <> 0 Then
                    Find = Find + Len(Delimiter)
                    Exit Property
                End If
                
                '4
                If m_lLength \ 2 >= Index + Len(Delimiter) Then
                    If StrComp(ToStringRight(Len(Delimiter)), Delimiter, CompareMethod) = 0 Then
                        Find = m_lLength \ 2 + 1 'returns a position bigger than the size of stringbuilder's data
                    End If
                End If
            End If
        End If
        Exit Property
    End If
    
    If m_lLength = 0 Then Exit Property
    
    If Len(Delimiter) = 0 Then
        Find = InstrPtr(StartPos, StrPtr(StrSearch), m_pMemoryPtr, CompareMethod)
    Else
        'Delimiter is ON
        'stady 1: search ^string$
        'stady 2: search ^string|$
        'stady 3: search .*|string|.*
        'stady 4: search .*|string$
        
        '1
        If (StartPos = 1) And (m_lLength \ 2 = Len(StrSearch)) Then
            If StrCompPtrEx(m_pMemoryPtr, StrPtr(StrSearch), Len(StrSearch), CompareMethod) = 0 Then
                Find = 1
                Exit Property
            End If
        End If
        
        '2
        If (StartPos = 1) And ((m_lLength \ 2) >= (Len(StrSearch) + Len(Delimiter))) Then
            If StrCompPtrEx(m_pMemoryPtr, StrPtr(StrSearch & Delimiter), Len(StrSearch) + Len(Delimiter), CompareMethod) = 0 Then
                Find = 1
                Exit Property
            End If
        End If
        
        '3
        Find = InstrPtr(StartPos, StrPtr(Delimiter & StrSearch & Delimiter), m_pMemoryPtr, CompareMethod)
        If Find <> 0 Then
            'consider len of delimiter
            Find = Find + Len(Delimiter)
            Exit Property
        End If
        
        '4
        If m_lLength \ 2 >= Index + Len(Delimiter) + Len(StrSearch) Then
            If StrCompPtrEx(m_pMemoryPtr + m_lLength - LenB(StrSearch) - LenB(Delimiter), _
              StrPtr(Delimiter & StrSearch), Len(Delimiter) + Len(StrSearch), CompareMethod) = 0 Then
                Find = m_lLength \ 2 - Len(StrSearch) + 1
                Exit Property
            End If
        End If
    End If
    
End Property

' #############################
'
'   InstrPtr
'   (analogue of Instr(), but takes pointers instead of strings.
'
'   Returns a position to the first occurrence of search string, or 0 if does not occur.
'
' #############################

Private Function InstrPtr(StartPos As Long, StrSearchFor As Long, StrSearchIn As Long, Optional CompareMethod As VbCompareMethod) As Long
    'Attention: no safe checkings here. Use with caution.
    If CompareMethod = vbTextCompare Then
        InstrPtr = StrStrIW(StrSearchIn + (StartPos - 1) * 2, StrSearchFor)
    Else
        InstrPtr = StrStrW(StrSearchIn + (StartPos - 1) * 2, StrSearchFor)
    End If
    If InstrPtr <> 0 Then
        InstrPtr = (InstrPtr - StrSearchIn) \ 2 + 1
    End If
End Function

' #############################
'
'   StrCompPtrEx
'   (something like StrComp(), but takes pointers instead of strings + the number of characters. So, strings can be not NUL terminated)
'
'   Returns FALSE, if strings are match, or TRUE if not.
'
' #############################

Private Function StrCompPtrEx( _
    StrString1 As Long, StrString2 As Long, _
    cchCount As Long, Optional CompareMethod As VbCompareMethod) As Boolean
    
    If m_bIsVistaAndNewer Then
        StrCompPtrEx = (CSTR_EQUAL <> CompareStringOrdinal(StrString1, cchCount, StrString2, cchCount, CompareMethod))
    Else
        
        Dim pStr1 As Long
        Dim pStr2 As Long
        Dim StrBuf1 As String
        Dim StrBuf2 As String
        
        'preparing NUL terminated strings
        If lstrlen(StrString1) = cchCount Then
            pStr1 = StrString1
        Else
            StrBuf1 = String$(cchCount, 0&)
            memcpy ByVal StrPtr(StrBuf1), ByVal StrString1, cchCount * 2
            pStr1 = StrPtr(StrBuf1)
        End If
        
        If lstrlen(StrString2) = cchCount Then
            pStr2 = StrString2
        Else
            StrBuf2 = String$(cchCount, 0&)
            memcpy ByVal StrPtr(StrBuf2), ByVal StrString2, cchCount * 2
            pStr2 = StrPtr(StrBuf2)
        End If
        
        If CompareMethod = vbTextCompare Then
            StrCompPtrEx = lstrcmpiW(pStr1, pStr2)
        Else
            StrCompPtrEx = lstrcmpW(pStr1, pStr2)
        End If
    End If
End Function


' #############################
'
'   Class_Terminate
'
'   Deallocates all allocated memory.
'
' #############################
Private Sub Class_Terminate()
    If m_hHeap <> 0 Then
        HeapDestroy m_hHeap
    End If
End Sub
```

----------


## Dragokas

Updated to v2.1

'   .Undo          method has been added (allows to revert to initial state from the last write operation, excepting .StringData; 1 step only)
'   .UndoAppend    method has been added (do .Undo if only last operation was .Append) (by jpbro's request)
'   .UndoInsert    method has been added (do .Undo if only last operation was .Insert)
'   .UndoOverwrite method has been added (do .Undo if only last operation was .Overwrite)
'   .UndoRemove    method has been added (do .Undo if only last operation was .Remove)

jpbro, no problem. I also sometimes hate to see how the code looks when removing manually such last delimiter ", ".
I just expanded Undo a bit to cover Insert/Overwrite/Remove. However, don't know is somebody will be fortunate to find where to apply undo on such methods in real task  :Smilie:

----------


## jpbro

Very nice update, thanks!

----------


## Schmidt

> For example, when building an SQL string I might need a list of field names all separated by commas except for the last field. In this case, the following:
> 
> 
> 
> ```
> For ii = 1 to Fields.Count
>    sb.Append Fields(ii).Name
>    sb.Append ", "
> Next ii
> ...


I often solve the above with a separate String-Array (which performs much better - e.g. in larger CSV-exports) - 
and it is not much more to code (same amount of lines).



```
Redim Tmp(1 to Fields.Count) As String 'the Fields-Count is usually known before entering the loop
For ii = 1 to Fields.Count
  Tmp(ii) = Fields(ii).Name
Next ii
sb.Append Join(Tmp, ", ")
```

BTW - I'm not sure, whether the larger efforts (dealing with separate Heap-Allocs) is worth it in a String-Builder-Class -
since I've found that a LeftHand-side Mid$-instruction works just as well (I use that simple scheme in the RC5-SB) -
below is a small performance-test (based on a simulated CSV-export-scenario with 32 Cols and 100000 rows).



```
Option Explicit

Private SArr(0 To 31, 0 To 100000) As String

Private Sub Form_Load() 'prefill a static string-array with the inputs
Dim x&, y&, S$
  For y = 0 To UBound(SArr, 2)
    S = "Row" & y & "_"
    For x = 0 To UBound(SArr, 1)
      SArr(x, y) = S & "Col" & x
    Next
  Next
End Sub

Private Sub Form_Click()
  AutoRedraw = True: Cls
  Dim x&, y&, Arr$()
  Dim SB1 As clsStringBuilder, SB2 As vbRichClient5.cStringBuilder
  
  New_c.Timing True
    Set SB1 = New clsStringBuilder
    ReDim Arr(0 To UBound(SArr, 1)) 'redim beforehand (the Column-Size is known)
    For y = 0 To UBound(SArr, 2)
      For x = 0 To UBound(SArr, 1)
        Arr(x) = SArr(x, y)
      Next
      SB1.Append Join(Arr, ", ")
      SB1.Append vbCrLf
    Next
  Print "SB1 Dragokas", New_c.Timing
  Set SB1 = Nothing
  
  New_c.Timing True
    Set SB2 = New_c.StringBuilder
    ReDim Arr(0 To UBound(SArr, 1)) 'redim beforehand (the Column-Size is known)
    For y = 0 To UBound(SArr, 2)
      For x = 0 To UBound(SArr, 1)
        Arr(x) = SArr(x, y)
      Next
      SB2.AppendNL Join(Arr, ", ")
    Next
  Print "SB2 RichClient", New_c.Timing
End Sub
```

The RC5-SB (using Mid$) being about factor 4 faster on my machine (for such larger outputs).

HTH

Olaf

----------


## killian353535

I agree with Olaf. I don't use the Mid$ method in VBCorLib, but do allocate a single string buffer and use CopyMemory, doubling the buffer size as it needs to grow. Using Olaf's benchmark, VBCorLib is an additional 30-40% faster than RC5. I'm not sure why. I want to think it's the difference with Mid$ and CopyMemory, but I can't believe it would cause that much of a discrepancy, so maybe the way the buffer is managed. 

This clsStringBuilder is nice, but it does seem a bit complex with buffer management. It does have a lot of features though. I'm always interested in seeing other people's implementations of similar classes.

----------


## wqweto

@killian353535: Adding to a VB.Collection is about 40% faster than appending to a RC5 cStringBuilder.

With an additional call to Len(SBx.ToString) the simple ConcatCollection still seems about 25% faster.

vb Code:
Private Sub Form_Click()  AutoRedraw = True: Cls  Dim x&, y&, Arr$()  Dim SB1 As clsStringBuilder, SB2 As vbRichClient5.cStringBuilder, SB3 As Collection    New_c.Timing True    Set SB1 = New clsStringBuilder    ReDim Arr(0 To UBound(SArr, 1)) 'redim beforehand (the Column-Size is known)    For y = 0 To UBound(SArr, 2)      For x = 0 To UBound(SArr, 1)        Arr(x) = SArr(x, y)      Next      SB1.Append Join(Arr, ", ")      SB1.Append vbCrLf    Next  Print "SB1 Dragokas", New_c.Timing, Len(SB1.ToString)  Set SB1 = Nothing    New_c.Timing True    Set SB2 = New_c.StringBuilder    ReDim Arr(0 To UBound(SArr, 1)) 'redim beforehand (the Column-Size is known)    For y = 0 To UBound(SArr, 2)      For x = 0 To UBound(SArr, 1)        Arr(x) = SArr(x, y)      Next      SB2.AppendNL Join(Arr, ", ")    Next  Print "SB2 RichClient", New_c.Timing, Len(SB2.ToString)    New_c.Timing True    Set SB3 = New Collection    ReDim Arr(0 To UBound(SArr, 1)) 'redim beforehand (the Column-Size is known)    For y = 0 To UBound(SArr, 2)      For x = 0 To UBound(SArr, 1)        Arr(x) = SArr(x, y)      Next      SB3.Add Join(Arr, ", ")    Next  Print "SB3 Collection", New_c.Timing, Len(ConcatCollection(SB3))End Sub
cheers,
</wqw>

----------


## killian353535

I'd be interested in seeing the ConcatCollection method. It must still have to iterate the collection and append into a final buffer. The difference with VBCorLib is that it is appending into a buffer with each call to Append so the final ToString method just returns a substring of the internal buffer. However, my way of doing things does prevent me from being able to Undo, such as the clsStringBuilder class was updated to do. But, yes the Collection class can be extremely fast with adding and iterating values. So that might be the best way to go if you're going to chunk as you did. VBCorLib doubles the buffer when increasing its capacity. Though you can set the capacity to a higher initial value if you know you're handling a lot of data. Cuts down on the doubling a bit. All-in-all I've seen many implementations of a string builder over the years. It's always interesting. Now if we can only get Olaf to share his  :Smilie:

----------


## Dragokas

Thanks, wqweto and Olaf. Nice tests.




> The RC5-SB (using Mid$) being about factor 4 faster on my machine (for such larger outputs).


It's because of too frequent reallocations. For such large data, initial Chunk increasing size in VolteFace's SB should be adjusted to ~ like 10 MB (Const CHUNK_SIZE = 10485760).
In such case above test returns on my machine in compiled mode:



> SB1 Dragokas	 568,67msec	49845014
> SB2 RichClient	 610,79msec	49845014
> SB3 Collection	 407,87msec	49645012

----------


## Schmidt

> Thanks, wqweto and Olaf. Nice tests.
> 
> It's because of too frequent reallocations. For such large data, initial Chunk increasing size in VolteFace's SB should be adjusted to ~ like 10 MB (Const CHUNK_SIZE = 10485760).
> In such case above test returns on my machine in compiled mode:


Yep, much depends on the re-allocation-scheme.

Though I'd consider an *initial* Chunk-allocation of 10MB a bit too much - in case the SB is fired-up 
as only an intermediate instance, to gather a few smaller string-snippets (in the 1-50KByte range).

A dynamic chunk-allocation covers both scenarios - although a factor 2 (as used by killian) is a bit much for my taste, I usually choose 1.6 as a compromise.

Here's an extract of the simple little SB-Class of the RC5 (I've removed the UTF8-stuff due to cross-refs into other RC5-modules)...
The way it is currently implemented represents, what one can achieve without API-usage (being quite universal in small- and large-size- concat-scenarios without being a slouch).



```
Option Explicit
 
Private mString As String, mCurPos As Long, mBufLen As Long
 
Public Property Get length() As Long
   length = mCurPos
End Property

Public Sub Append(ByRef NextPart As String)
Dim lLen As Long
    lLen = Len(NextPart)

    If lLen + mCurPos >= mBufLen Then
       mString = mString & Space$(mCurPos * 1.6 + lLen + 8192)
       mBufLen = Len(mString)
    End If
   
    Mid$(mString, mCurPos + 1) = NextPart: mCurPos = mCurPos + lLen
End Sub

Public Sub AppendNL(ByRef NextPart As String, Optional NLChars As String = vbNewLine)
   Append NextPart
   Append NLChars
End Sub

Public Sub Clear()
   mString = vbNullString: mCurPos = 0: mBufLen = 0
End Sub

Public Property Get ToString() As String
   If mCurPos > 0 Then ToString = Left$(mString, mCurPos)
End Property
```

Olaf

----------


## killian353535

I can see a factor of 2 might be too much at times. Never even though about changing it, maybe even letting it be adjustable. You've given me something to think about.

So I noticed something about your extracted RC5 code and made a change to see how your test was affected. So I created two SB classes and in keeping with your no API-usage I removed one of the string allocations when you're expanding the buffer.

in one of the classes I replaced:


```
mString = mString & Space$(mCurPos * 1.6 + lLen + 8192)
```

with:


```
Dim NewString As String
NewString = Space$(mBufLen + mCurPos * 1.6 + lLen + 8192)
Mid$(NewString, 1) = mString
mString = NewString
```

Re-running your benchmark yielded a 10% speed increase. Now I can't comment how it would fair within RC5 since you stated you had removed some things.

I seem to get caught up in little details, but I find it fun. And if you can't have fun in VB6 you're wasting your time  :Smilie:

----------


## jpbro

Bumping the chunk size in Dragokas' code certainly improves performance at the expense of memory of course. It's usually slightly faster than RC5 in this case.

I didn't try ConcatCollection because I don't see where that code is??

I've just tried using an array of Strings with Join$ for the Value and it is giving me the best performance now (CStringBuilderJ):



```
Option Explicit

Public Enum e_AppendModifier
   [_appendmod_Ignore] = -1   ' Internal use
   
   appendmod_None
   
   appendmod_CrLf ' Append CRLF after primary append operation
   appendmod_Lf ' Append LF after primary append operation
End Enum

Private Const mc_BufferSize As Long = 128

Private ma_Strings() As String
Private m_NextIndex As Long
Private m_UndoBump As Long
Private m_Undoable As Boolean

Public Property Get Value() As String
   If UBound(ma_Strings) <> m_NextIndex - 1 Then
      ReDim Preserve ma_Strings(m_NextIndex - 1)
   End If
   
   Value = Join$(ma_Strings, "")
End Property

Public Sub Undo()
   Dim ii As Long
   
   If Not m_Undoable Then Err.Raise 5, , "Undo buffer is exhausted."
   If m_NextIndex = 0 Then Err.Raise 5, , "Nothing to undo."
         
   m_Undoable = False
   
   For ii = 0 To m_UndoBump
      m_NextIndex = m_NextIndex - 1
      ma_Strings(m_NextIndex) = ""
   Next ii
End Sub

Public Sub Append(ByVal p_String As String, Optional ByVal p_Modifier As e_AppendModifier)
   Dim l_ReRun As Boolean
   
   m_Undoable = True
   
   Do
      If m_NextIndex = 0 Then
         ReDim ma_Strings(mc_BufferSize - 1)
      Else
         If m_NextIndex > UBound(ma_Strings) Then
            ReDim Preserve ma_Strings(UBound(ma_Strings) + mc_BufferSize - 1)
         End If
      End If
      
      ma_Strings(m_NextIndex) = p_String
      m_NextIndex = m_NextIndex + 1
         
      If p_Modifier > appendmod_None Then
         m_UndoBump = 1
         l_ReRun = True
         
         Select Case p_Modifier
         Case appendmod_CrLf
            p_Modifier = [_appendmod_Ignore]
            p_String = vbCrLf
            
         Case appendmod_Lf
            p_Modifier = [_appendmod_Ignore]
            p_String = vbLf
            
         End Select
         
      Else
         l_ReRun = False
         
         If p_Modifier = appendmod_None Then
            m_UndoBump = 0
         End If
         
      End If
   Loop While l_ReRun
End Sub
```

Some timings:

Dragokas (large buffer): 711.53ms
RC5: 880.38ms
jpbro: 589.47ms

----------


## Dragokas

jpbro, see post #11.
BTW, here is a project with all 4 tests.

----------


## jpbro

Here are the timings I get using Dragokas' project in post #32:



Strangely the length of the Collection-based demo is short 2 characters? Missing a trailing CRLF?

----------


## Schmidt

> jpbro, see post #11.
> BTW, here is a project with all 4 tests.


A quite similar result to the "VB-Collection-Concat approach" can be achieved with the RC5-cArrayList (which has a Join-method).
Adding the following into the Test-Setup:


```
  New_c.Timing True
    Dim SB5 As cArrayList
    Set SB5 = New_c.ArrayList(vbString)
    ReDim Arr(0 To UBound(SArr, 1)) 'redim beforehand (the Column-Size is known)
    For y = 0 To UBound(SArr, 2)
      For x = 0 To UBound(SArr, 1)
        Arr(x) = SArr(x, y)
      Next
      SB5.Add Join(Arr, ", ")
    Next
    SB5.Add ""
  s = s & vbCrLf & "RC5-ArrList" & vbTab & New_c.Timing & vbTab & Len(SB5.Join(vbCrLf))
  txtText1.Text = s
  Set SB5 = Nothing
```

Will give the following results on my machine:


```
SB1 Dragokas     659,40msec    49845014
SB2 RichClient     674,27msec    49845014
SB3 Collection     419,34msec    49645012
SB4 Array     468,37msec    49845014
RC5-ArrList     427,85msec    49845014
```

Edit: Have just seen, that the retrieval of the resulting String-Concat was outside the Timing.
To remedy that I've included (after each of the Test-Loops):


```
Dim L&
...
  L = Len(ConcatCollection(SB3)) 'or ToString or .Value or whatever is needed to get the result
  x = x & New_c.Timing & ... & L
```

With that corrected, the timings now look this way:


```
SB1 Dragokas     743,69msec    49845014
SB2 RichClient     731,06msec    49845014
SB3 Collection     592,07msec    49645012
SB4 Array     533,32msec    49845014
RC5-ArrList     488,13msec    49845014
```


Olaf

----------


## killian353535

Dragokas, the collection isn't including vbCrLf. But that aside, I don't think the timing is accurate since RC5 does 99% of the work on each append instead of a form of chunking as the rest do. By moving the New_c.Timing to the end of the description string it will include the entire building process. 

With that I get the Array version as the fastest. I included VBCorLib for my comparison and added the vbCrLf for the collection version.



```
SB1 Dragokas: 525.05ms
SB2 RichClient: 535.24ms
SB3 Collection: 442.38ms
SB4 Array: 353.62ms
SB5 VBCorLib: 363.50ms
```

This thread has been hijacked with these comparisons, but it has been enlightening.

----------


## Dragokas

> This thread has been hijacked with these comparisons, but it has been enlightening.


Not problem, you all helped me a lot in understanding of alternatives and also how to improve my own fork in speed.
I already done 1.6 factor increasing of Chunk and it show even more performance.

killian353535, give me code example for VBCorLib based SB and I'll include it to the tests.
Is that VBCorLib.dll (modified 08.06.2008) at Github is a latest version?

----------


## jpbro

After moving all the Timing calls _after_ any final calls to the stringbuilder implementations, I'm basically getting a wash between wqweto's Collection, my String() array, and Olaf's RC5 ArrayList approaches. Running multiple tests, sometimes any one of them come out ahead marginally over the others - all around the 500-600 msec range for me.

Dragokas' heap approach with large buffer and Olaf's current RC5 StringBuilder implementation are slightly slower, both in the 700-800 msec range. Again, the winner flip-flops a bit between either in multiple timing tests.

----------


## Schmidt

> Dragokas, the collection isn't including vbCrLf.


Yep, but that can be corrected with an:
SB3.Add ""
after the outer loop (similar to what I did with the cArrayList-approach - I think you also have that in your CorLib - worth a try I think).




> By moving the New_c.Timing to the end of the description string it will include the entire building process.


Yep. In my prior posting I've suggested to use a Long-Variable to gather the resulting Len - but that will work as well.




> With that I get the Array version as the fastest. I included VBCorLib for my comparison and added the vbCrLf for the collection version.
> 
> 
> 
> ```
> SB1 Dragokas: 525.05ms
> SB2 RichClient: 535.24ms
> SB3 Collection: 442.38ms
> SB4 Array: 353.62ms
> ...


You have a quite fast machine - could you run it again with the cArrayList included (and perhaps your own ArrayList-Join from your CorLib)?

Olaf

----------


## Dragokas

Made 6 tests with 10 rounds. Also improved my fork to init. buf. with 1 MB + every increase as *1.6 factor.




> Average:
> SB1 Heap-memcpy  	0,57223
> SB2 RichClient:  	0,71915
> SB3 Collection:  	0,48291
> SB4 Array:       	0,52808
> SB5 RC5-ArrList: 	0,509
> SB6 VBCorLib:    	0,56692

----------


## killian353535

@Dragokas, yes the v2.3 release on github is indeed the latest. It's been that long since an updated release, though I keep plugging away on the code.

@Olaf, ok I've added the new comparisons to the mix:



```
SB1 Dragokas		49845014 505.05msec
SB2 RichClient		49845014 531.51msec
SB3 Collection		49845014 410.09msec
SB4 Array		49845014 353.82msec
SB5 VBCorLIlb		49845014 365.48msec
RC5-ArrList		49845014 324.62msec
VBCorLib-ArrayList		49845014 375.55msec
```

Your arraylist version is the fastest, pretty cool. Mine doesn't have a join so I had to fallback to joining the array that the list can output.

----------


## jpbro

I should add that for my initial assessment of Dragokas' code with the smaller buffer being around 2x as fast compared to what I was using before (a variation on my posted Array approach) - This is still the case when doing a smaller # of smaller string concats (for example, when building something like an SQL string).



```
Private Sub Form_Click()
   AutoRedraw = True: Cls
   Dim x&, y&, Arr$()
   Dim SB1 As clsStringBuilder, SB2 As vbRichClient5.cStringBuilder, SB3 As Collection, SB4 As CStringBuilderJ
   Dim s$


   New_c.Timing True
   Set SB1 = New clsStringBuilder
   For x = 1 To 1000
      SB1.Clear
      For y = 1 To 100
         SB1.Append String$(100, "A")
         SB1.Append vbNewLine
      Next y
   Next x
   s = s & vbCrLf & "Short Dragokas" & vbTab & Len(SB1.ToString)
   s = s & vbTab & New_c.Timing

   New_c.Timing True
   Set SB2 = New_c.StringBuilder
   For x = 1 To 1000
      SB2.Clear
      For y = 1 To 100
         SB2.AppendNL String$(100, "A")
      Next y
   Next x
   s = s & vbCrLf & "Short RC5-SB" & vbTab & Len(SB2.ToString)
   s = s & vbTab & New_c.Timing

   New_c.Timing True
   For x = 1 To 1000
      Set SB3 = New Collection  '  No Clear/RemoveAll method on VB collection
      For y = 1 To 100
         SB3.Add String$(100, "A")
         SB3.Add vbNewLine
      Next y
   Next x
   s = s & vbCrLf & "Short VB6 Collection" & vbTab & Len(ConcatCollection(SB3))
   s = s & vbTab & New_c.Timing
   Set SB3 = Nothing

   New_c.Timing True
   Set SB4 = New CStringBuilderJ
   For x = 1 To 1000
      SB4.Clear
      For y = 1 To 100
         SB4.Append String$(100, "A"), appendmod_CrLf
      Next y
   Next x
   s = s & vbCrLf & "Short Array" & vbTab & Len(SB4.Value)
   s = s & vbTab & New_c.Timing

   New_c.Timing True
   Dim SB5 As cArrayList
   Set SB5 = New_c.ArrayList(vbString)
   For x = 1 To 1000
      SB5.RemoveAll
      For y = 1 To 100
         SB5.Add String$(100, "A")
      Next y
      SB5.Add vbNewLine
   Next x
   s = s & vbCrLf & "Short RC5-ArrList" & vbTab & Len(SB5.Join(vbCrLf))
   s = s & vbTab & New_c.Timing

   txtText1.Text = s
   Set SB5 = Nothing
End Sub
```

----------


## jpbro

@Olaf - since the RC5ArrayList approach seems fastest, would there be worth it to update the RC5 StringBuilder class to use it? Or are there features of the StringBuilder class that would make that too painful or not worthwhile (like the UTF8 and XML functions)?

----------


## killian353535

@Dragokas, I still don't think the timing is accurate. I see you're using a different timer. So to more accurately portray the work, each builder should output its final string before the cTim(x).Freeze method call.

----------


## Dragokas

killian353535, no, there is all okay with that.
if .Freeze is called first, .GetTime and .GetTimeLastStep methods doesn't call QueryPerformanceCounter API anymore until .Start method will be called.

----------


## killian353535

@Dragokas, that is the problem  :Smilie:  For instance, many of the versions don't assemble the string until the end of the description string.

For example, the collection version doesn't include the time required to actually assemble the final string.


```
  cTim(3).Freeze
  s = s & vbCrLf & "SB3 Collection" & vbTab & cTim(3).GetTimeLastStep & vbTab & Len(ConcatCollection(SB3))
```

Pretty much all versions have some work to be done when getting the length to include in the description string. That work should be included in the time since that is the only time we build the final string.

----------


## Dragokas

killian353535, I see. Sorry. You are right. Even more, it is not accurate even if set .Freeze (or New_c.Timing) as inline after Len(.ToString), because ~ 30 msec. took an execution of this line before reach the code of counting average values.
I fixed it in new test + added VBCorLib ArrList.



> Average:
> SB1 Heap-memcpy  	0,55647
> SB2 RichClient:  	0,63096
> SB3 Collection:  	0,50734
> SB4 Array:       	0,49762
> SB5 RC5-ArrList: 	0,45676
> SB6 VBCorLib SB: 	0,49862
> VBCor-ArrList:   	0,60125


StringBuilder by VolteFace updated to *v2.2*
'   .AppendLine method has been added (same as .Append, but also adds CrLf characters to the end of string)
'   Speed is improved (reallocation of buffer is now *= 1.6 instead of += CHUNK_SIZE ).

----------


## killian353535

Dragokas, thank you for the all the work! It's been great to see all the thought processes. I find it interesting that the RC5 ArrayList solution is the fastest, since it wasn't even originally thought of. I like being surprised  :Smilie:   In the end it seems so close that any of them would perform plenty fast for given situations.

----------


## Schmidt

> @Olaf - since the RC5ArrayList approach seems fastest, would there be worth it to update the RC5 StringBuilder class to use it?


I was quite surprised myself - but (as seen in my post #29), the RC5-StringBuilder was implemented straight-forward (not yet optimized).

I've optimized it now (new version 5.0.65 is online) - and the new implementation (still using the same principle as before) 
is now slightly faster than the ArrayList in nearly every scenario (just changed the LeftHand-Mid to typelib-based RtlMoveMemory and the 
reallocations to SysReAllocStringLen in the Append-Method).

It now works at a speed-level, that the small Temp-Array-Buffering-trick (to gather the Column-Values and avoid high-frequent COM-calls to .Append)
is only worthwhile for larger Column-Aggregation-Counts (as e.g. 32) - below that, direct Appends work faster as it seems.

I wrote a small Test-App, which can now apply different Row- and ColumnCounts to the TestRoutines 
(to test the SBs in midsized and smallsized scenarios as well - included is the version *v2.2* from Dragokas, as posted in #46).
SBTests.zip

Here is a ScreenShot:


The above shows the already well-known scenario (100,000 rows x 32 cols) - 
but a midsized one and a small one are included as well.

The "Pure" routines do not make use of the tmp-Array-trick (feeding the SBs directly).

HTH

Olaf

----------


## jpbro

@Olaf - those optimizations are performing very nicely here in my tests. In fact, it looks like I will replace my Array/Join based StringBuilder with the RC5 StringBuilder now. While the Array/Join approach performs respectably close on the smaller tests, it performs increasingly poorly on larger "pure" tests.

----------


## DEXWERX

It looks like Dragokas SB performs quite well!

----------


## Dragokas

Updated to v2.3
Fixed issue when .ToString and .ToStringRight methods returns trimmed string when buffer contains NUL characters.

----------


## Niya

Threads like this make me miss VB6. I used to have a lot of fun getting my hands dirty with stuff like this. Modern frameworks have everything now. I rarely get a chance to get down and dirty like this. 

Great thread. Enjoyed reading all the posts.

----------


## dreammanor

The reason why scripting languages like Python and JavaScript are becoming more and more popular is that they have a large number of modern frameworks and third-party libs. VB6 is both an interpreted language and a compiled language, and its potential should be more powerful than scripting languages if VB6 also has similar modern frameworks and third-party libs. Sadly, stupid Microsoft gave up VB6. But until now there are still many people who love VB6 very much. Thank you, Dragokas and other enthusiastic people.

----------


## darjeeling

@Dragokas,
Great ! 
Maybe a 'GetBetween' function will be useful.

----------


## darjeeling

@Dragokas,
Great ! 
Maybe a 'GetBetween' function will be useful.

----------


## Dragokas

Hi, darjeeling!

What is it mean? Like GetBetween( x, y) = Mid$(str, x, y - x +1) ?

----------


## darjeeling

Like this;:
Public Function GetBetween(ByRef sStart As String, _
                           ByRef sStop As String, _
                           Optional RemoveSpaces As Boolean = False, _
                           Optional ByRef first As Long = 1) As String
Dim Temp$
Dim second&
first = sb.Find(1, sStart)
If first > 0 Then
    second = sb.Find(first + Len(sStart), sStop)
End If
If second > first Then
    first = first + Len(sStart)
    Temp$ = sb.ToStringMid(first, second - 1 - first)
    If RemoveSpaces Then Temp$ = Trim$(Temp$)
    GetBetween = Temp$
End If
End Function

ex:.../...
sb.Append "Very large concatenation string is a real programming intention "
Text1 = GetBetween("real", "intention", True) 'Return -> programming 
.../...

----------


## hennyere

[QUOTE=Dragokas;5168793]*v.2.3.*
It's well-tested class for concatenating strings like:


```
s = s & "one line"
s = s & "two line"
...
s = s & "N line"
```

but much much more faster than VB runtime do it.

Cases when it is needed sometimes:
Well, e.g., I'm using it to prepare some really huge logs of program in a single 'String' variable (e.g. up to 1 MB.) rather then writing them line by line to file (for performance acceleration purposes, if debug mode of my app. is disabled).
Don't know what else good cases. Better, don't store large data in this way, use suitable tools: arrays, databases ...

Using examples:


```

Option Explicit

Private Sub Form_Load()
    'init 
    Dim sb As clsStringBuilder
    Set sb = New clsStringBuilder

    'concatenation 
    sb.Append "Very "
    sb.Append "many "
    sb.Append "pieces "
    sb.Append "of data"

    'result 
    Debug.Print "All data: "; sb.ToString
    Debug.Print "Len of data: "; sb.length

    'removing 5 characters from position # 1 
    sb.Remove 1, 5
    Debug.Print "New data: "; sb.ToString

    'inserting string in position # 1 
    sb.Insert 1, "Not "
    Debug.Print "New data: "; sb.ToString

    'overwrite part of the text from position # 1 (same like MID(str,x) = "...") 
    sb.Overwrite 1, "How"
    Debug.Print "New data: "; sb.ToString

    'getting 2 first characters 
    Debug.Print "2 left chars: "; sb.ToStringLeft(2)

    'getting 2 characters from the end 
    Debug.Print "2 end chars: "; sb.ToStringRight(2)

    'getting 2 characters from the middle, beginning from position 6 
    Debug.Print "2 middle chars: "; sb.ToStringMid(6, 2)

    'getting a pointer to a NUL terminated string to use somehow (e.g. write on disk by ptr, WriteFile, e.t.c.) 
    'this method is much faster than .ToString() 
    'warning: you should use this pointer before calling next any method of StringBuilder, that may cause changing its data 
    Debug.Print "ptr to string: "; sb.ToStringPtr

    'replacing the data (same as Clear + Append) 
    sb.StringData = "Anew"
    Debug.Print "New data: "; sb.ToString

    'go to the next line (append CrLf) 
    sb.AppendLine ""
    'append second line with CrLf at the end 
    sb.AppendLine "Second line"
    'append third line without CrLf 
    sb.Append "Third Line"

    Debug.Print sb.ToString

    'clear all data 
    sb.Clear
    Debug.Print "Len of data (after clear): "; sb.length

    'Search samples (by default search is case sensitive) 
    'Set new data 
    sb.StringData = "|textile|Some|text|to|search"
    Debug.Print "New data: "; sb.ToString

    'Simple search ('text' will be found inside 'textile' word) 
    Debug.Print "Position of 'text': " & sb.Find(1, "text")

    'Simple search (start search from position 3) 
    Debug.Print "Position of 'text': " & sb.Find(3, "text")

    Debug.Print "'some' (case sensitive): " & sb.Find(1, "some")
    Debug.Print "'some' (case insensitive): " & sb.Find(1, "some", , vbTextCompare)

    'Search by delimiter 
    Debug.Print "searching for |text|: " & sb.Find(1, "text", "|")

    'Search for empty string, saved with delimiter | 
    Debug.Print "empty string (delim = '|'): " & sb.Find(1, "", "|")

    'Undo operations 
    sb.StringData = "Some data "
    Debug.Print "Orig. string: " & sb.ToString

    sb.Append "remove"
    Debug.Print "After Append: " & sb.ToString
    'or you can use .UndoAppend 
    sb.Undo
    Debug.Print "After Undo:   " & sb.ToString

    sb.Insert 6, "bad "
    Debug.Print "After Insert: " & sb.ToString
    'or you can use .UndoInsert 
    sb.Undo
    Debug.Print "After Undo:   " & sb.ToString

    sb.Overwrite 1, "Here"
    Debug.Print "After Overwrite: " & sb.ToString
    'or you can use .UndoOverwrite 
    sb.Undo
    Debug.Print "After Undo:      " & sb.ToString

    sb.Remove 2, 5
    Debug.Print "After Remove: " & sb.ToString
    'or you can use .UndoRemove 
    sb.Undo
    Debug.Print "After Undo:   " & sb.ToString

    'when you finished work with the class 
    Set sb = Nothing

    Unload Me
End Sub


```

Hi, *Dragokas*!

Congratulations on your code. He really is very good and very fast!
I would like to suggest the function *GetString (Index As Long) As String*. The purpose is returns the string at an indexed location within the internal collection. For example:



```
MyStr.Append "One"
MyStr.Append "Two"
MyStr.Append "Tree"

Debug.Print MyStr.GetString(1) 'Returns the string named "Two"
```

Thank you for this!

----------


## vb6locked

Thank you  Dragokas.

I saw "HUGE" improvements in speed when i incorporated your code.  
I have written a project where multiple clients push satellite data to the server so there is a central pool of whats currently available. 
I was using huge amounts of   

```
string = string + string
```

 to build a packet that would be issued out.  This is in two formats, http as there is a web portal and then a client/server packet.  

You start out not worrying about it and then it becomes noticeable if you don't do anything about it.  I always believe in seeing if someone else out there has done the work and in your case Kudos.  

To give you one example, things which took a couple seconds now take 100th of a second.  

It was easy to port your class in, and quickly utilize it.   Thanks again!!!  Your work is much appreciated.

----------


## Dragokas

You are welcome.

----------


## Black_Storm

its not support utf-8? i tested cant find utf-8 strings,any sample or class for can compare or find utf-8 string in another utf-8 string?

----------


## Arnoutdv

UTF8?
All internal VB6 strings are unicode.
The conversion from unicode to an UTF8 byte array is only performed when you save it to disk.
When you get/read an byte array containing utf8 the you need to convert it back to unicode.

There are multiple samples on the forum on how to these conversions

----------


## Dragokas

Black_Storm, it would be better you describe your entire use case. Some code from you can explain.
Also, are you sure that you provide a substring in the same utf8 format?
Generally, the class is not intended for utf8.

----------


## Arnoutdv

No, you should keep it as it is.
Black_Storm should use the 2 functions already created by Merri

He also asked for UTF8 controls and much more.
He should deal with his data as normal strings and only convert them when receiving the data.




```
' StrConvUTF8.bas
Option Explicit

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long

Public Function StrConvFromUTF8(Text As String) As String
    ' get length
    Dim lngLen As Long, lngPtr As Long: lngLen = LenB(Text)
    ' has any?
    If lngLen Then
        ' create a BSTR over twice that length
        lngPtr = SysAllocStringLen(0, lngLen * 1.25)
        ' place it in output variable
        PutMem4 VarPtr(StrConvFromUTF8), lngPtr
        ' convert & get output length
        lngLen = MultiByteToWideChar(65001, 0, ByVal StrPtr(Text), lngLen, ByVal lngPtr, LenB(StrConvFromUTF8))
        ' resize the buffer
        StrConvFromUTF8 = Left$(StrConvFromUTF8, lngLen)
    End If
End Function

Public Function StrConvToUTF8(Text As String) As String
    ' get length
    Dim lngLen As Long, lngPtr As Long: lngLen = LenB(Text)
    ' has any?
    If lngLen Then
        ' create a BSTR over twice that length
        lngPtr = SysAllocStringLen(0, lngLen * 1.25)
        ' place it in output variable
        PutMem4 VarPtr(StrConvToUTF8), lngPtr
        ' convert & get output length
        lngLen = WideCharToMultiByte(65001, 0, ByVal StrPtr(Text), Len(Text), ByVal lngPtr, LenB(StrConvToUTF8), ByVal 0&, ByVal 0&)
        ' resize the buffer
        StrConvToUTF8 = LeftB$(StrConvToUTF8, lngLen)
    End If
End Function
```

----------


## xiaoyao

Cant Undo for Append


```
   StrEx.Add "remove"
    Debug.Print "After Add: " & StrEx.ToString
    'or you can use .UndoAppend
    StrEx.Undo
   
    Debug.Print "After Undo:   " & StrEx.ToString
```

After Append: Some data remove
After Undo:   Some data  emove

CHANGE TO 


```
Public Function Undo() As Boolean
    Undo = True
    m_bInRevert = True
    Select Case m_LastOp
        Case StrEx_LAST_Add
            'GetMem2 ByVal StrPtr(vbNullChar), ByVal (m_pMemoryPtr + m_UndoIndexStart * 2)'YOUR CODE
            Lenb2 = m_UndoIndexStart * 2 'I CHANGE IT，abcd
            
        Case StrEx_LAST_INSERT
            Remove m_UndoIndexStart + 1, m_UndoLength
            
        Case StrEx_LAST_OVERWRITE
            Overwrite m_UndoIndexStart + 1, m_UndoText
            m_UndoText = vbNullString
            
        Case StrEx_LAST_REMOVE
            Insert m_UndoIndexStart + 1, m_UndoText
            m_UndoText = vbNullString
            
        Case 0
            Undo = False
    End Select
    m_LastOp = 0 'disallow dual .Undo call
    m_bInRevert = False
End Function
```

----------

