[RESOLVED] Split Function equivalent in VB5?

[Set me As newtype]

Gents -

I need to "split" a string of file names, as returned from a common dialog with multiple select flag set.

I found lots of threads that show how to do this with Split, but I get an Unknown Function type of error in VB5...

Any suggestions?

[MartinLiss]

Take a look here.

[Ellis Dee]

Public Function Split(pstrText As String, pstrDelimiter As String, Optional plngBuffer As Long = 256) As String()
    Dim strBuffer() As String
    Dim lngIndex As Long
    Dim lngArraySize As Long
    Dim lngPos As Long
    Dim lngPrev As Long
    
    lngArraySize = plngBuffer - 1
    ReDim strBuffer(lngArraySize)
    lngPos = 1
    Do
        lngPrev = lngPos
        lngPos = InStr(lngPos, pstrText, pstrDelimiter)
        If lngPos = 0 Then Exit Do
        strBuffer(lngIndex) = Mid$(pstrText, lngPrev, lngPos - lngPrev)
        lngIndex = lngIndex + 1
        If lngIndex > lngArraySize Then
            lngArraySize = lngArraySize + plngBuffer
            ReDim Preserve strBuffer(lngArraySize)
        End If
        lngPos = lngPos + Len(pstrDelimiter)
    Loop Until lngPos > Len(pstrText)
    If lngPos <= Len(pstrText) Then strBuffer(lngIndex) = Mid$(pstrText, lngPrev)
    ReDim Preserve strBuffer(lngIndex)
    Split = strBuffer
    Erase strBuffer
End Function

Note that this includes a third parameter not found in the native Split() function. The buffer length allows you to specify an efficient buffer size. If the resulting array is going to contain thousands of elements, set the buffer to something high like 1024. If it's going to be really small, you could make it 8 or 16. It defaults to 256 as a compromise to offer reasonably good performance for all cases.

On preview: This will be much more efficient (faster) than the linked solution, which doesn't use a buffer at all. That means it will have to make a copy of the entire array for every element it adds, drastically reducing performance if the returned array size is anything bigger than tiny.

[Set me As newtype]

Martin & Ellis -

THANK YOU BOTH! Both solutions work, but I think Ellis makes a good point, so I'll go with his solution (for now!).

[Logophobic]

Regarding Ellis Dee's code, it can be made generally more efficient by using a long array to store the positions of the delimiter. ReDimming the long array, if necessary, will be faster than ReDimming the string array.

Edit: I have run a few short time tests. Compiled with advanced options, Ellis Dee's code with default buffer was than VB6 Split function for large arrays. While my modification was more efficient, similar improvement can be achieved by simply doubling the size of the array whenever more space is needed.

[Ellis Dee]

Regarding Ellis Dee's code, it can be made generally more efficient by using a long array to store the positions of the delimiter. ReDimming the long array, if necessary, will be faster than ReDimming the string array.

I figured as much based on the Join() thread yesterday, but frankly I was too lazy to bother with a second array this time around. heh.

Edit: I have run a few short time tests. Compiled with advanced options, Ellis Dee's code with default buffer was than VB6 Split function for large arrays.

Faster? Slower? Stupider? GAH! You're killing me with suspense over here...

While my modification was more efficient, similar improvement can be achieved by simply doubling the size of the array whenever more space is needed.

This is pure brilliance. I wracked my brain trying to figure out how in the heck the native Split() function could be efficient given a completely unknown return array size. This has to be what it does. I like it so much that I'm going to implement it right now and post a new benchmark.

That way I'll never forget this truly clever approach to handling unknown buffer sizes.

[Ellis Dee]

Okay, after spending way too much time setting up a generic benchmark template, I finally got around to testing. The doubling idea is fantastic. Here's the speed differences between the native Split() function, the original method I posted upthread (using default buffer size of 256), and the same method improved with Logo's doubling idea:

Split(): 0.02ms (10 elements)
SplitEllis(): 0.03ms (10 elements)
SplitDouble(): 0.03ms (10 elements)

Split(): 0.20ms (100 elements)
SplitEllis(): 0.24ms (100 elements)
SplitDouble(): 0.25ms (100 elements)

Split(): 3.22ms (1,000 elements)
SplitEllis(): 4.51ms (1,000 elements)
SplitDouble(): 3.72ms (1,000 elements)

Split(): 58.25ms (10,000 elements)
SplitEllis(): 77.45ms (10,000 elements)
SplitDouble(): 57.10ms (10,000 elements)

Split(): 982.77ms (100,000 elements)
SplitEllis(): 1,418.40ms (100,000 elements)
SplitDouble(): 542.38ms (100,000 elements)

As you can see, the doubling method scales very well, is relatively efficient when it comes to memory usage regardless of the array size it creates, and it has the added bonus of not requiring the programmer to come up with a good buffer size. Here's the code:

Public Function Split(pstrText As String, pstrDelimiter As String) As String()
    Dim strBuffer() As String
    Dim lngIndex As Long
    Dim lngArraySize As Long
    Dim lngPos As Long
    Dim lngPrev As Long
    
    lngArraySize = 16 ' Minimal starting overhead
    ReDim strBuffer(lngArraySize)
    lngPos = 1
    Do
        lngPrev = lngPos
        lngPos = InStr(lngPos, pstrText, pstrDelimiter)
        If lngPos = 0 Then Exit Do
        strBuffer(lngIndex) = Mid$(pstrText, lngPrev, lngPos - lngPrev)
        lngIndex = lngIndex + 1
        If lngIndex > lngArraySize Then
            lngArraySize = lngArraySize * 2
            ReDim Preserve strBuffer(lngArraySize)
        End If
        lngPos = lngPos + Len(pstrDelimiter)
    Loop Until lngPos > Len(pstrText)
    If lngPos <= Len(pstrText) Then strBuffer(lngIndex) = Mid$(pstrText, lngPrev)
    ReDim Preserve strBuffer(lngIndex)
    Split = strBuffer
    Erase strBuffer
End Function

Here's the code to the benchmark program. Create a new project, add a multi-line textbox and a command button to the form, then copy this code to the form's module:

Option Explicit

'Private Const ArraySize = 9999
Private ArraySize As Long
Private Const Delimiter = " "
Private Const MinLen = 10
Private Const MaxLen = 20

Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Function SplitEllis(pstrText As String, pstrDelimiter As String, Optional plngBuffer As Long = 256) As String()
    Dim strBuffer() As String
    Dim lngIndex As Long
    Dim lngArraySize As Long
    Dim lngPos As Long
    Dim lngPrev As Long
    
    lngArraySize = plngBuffer - 1
    ReDim strBuffer(lngArraySize)
    lngPos = 1
    Do
        lngPrev = lngPos
        lngPos = InStr(lngPos, pstrText, pstrDelimiter)
        If lngPos = 0 Then Exit Do
        strBuffer(lngIndex) = Mid$(pstrText, lngPrev, lngPos - lngPrev)
        lngIndex = lngIndex + 1
        If lngIndex > lngArraySize Then
            lngArraySize = lngArraySize + plngBuffer
            ReDim Preserve strBuffer(lngArraySize)
        End If
        lngPos = lngPos + Len(pstrDelimiter)
    Loop Until lngPos > Len(pstrText)
    If lngPos <= Len(pstrText) Then strBuffer(lngIndex) = Mid$(pstrText, lngPrev)
    ReDim Preserve strBuffer(lngIndex)
    SplitEllis = strBuffer
    Erase strBuffer
End Function

Public Function SplitDouble(pstrText As String, pstrDelimiter As String) As String()
    Dim strBuffer() As String
    Dim lngIndex As Long
    Dim lngArraySize As Long
    Dim lngPos As Long
    Dim lngPrev As Long
    
    lngArraySize = 16 ' Minimal overhead
    ReDim strBuffer(lngArraySize)
    lngPos = 1
    Do
        lngPrev = lngPos
        lngPos = InStr(lngPos, pstrText, pstrDelimiter)
        If lngPos = 0 Then Exit Do
        strBuffer(lngIndex) = Mid$(pstrText, lngPrev, lngPos - lngPrev)
        lngIndex = lngIndex + 1
        If lngIndex > lngArraySize Then
            lngArraySize = lngArraySize * 2
            ReDim Preserve strBuffer(lngArraySize)
        End If
        lngPos = lngPos + Len(pstrDelimiter)
    Loop Until lngPos > Len(pstrText)
    If lngPos <= Len(pstrText) Then strBuffer(lngIndex) = Mid$(pstrText, lngPrev)
    ReDim Preserve strBuffer(lngIndex)
    SplitDouble = strBuffer
    Erase strBuffer
End Function

Private Sub Command1_Click()
    Me.MousePointer = vbHourglass
    Me.Text1.Text = Sample()
    Me.MousePointer = vbNormal
End Sub

Public Function Sample() As String
    Dim strArray() As String
    Dim i As Long
    Dim j As Long
    Dim strText As String
    Dim strMessage As String
    Dim dblFrequency As Double
    Dim curStart As Currency
    Dim curStop As Currency
    Dim dblTime(1 To 3) As Double
    
    QueryPerformanceFrequency curStart
    dblFrequency = CDbl(curStart)
    ArraySize = Val(Me.Text1.Text)
    For i = 1 To 10
        ' Create string
        ReDim strArray(ArraySize)
        For j = 0 To ArraySize
            strArray(j) = String(j Mod (MaxLen - MinLen + 1) + MinLen, j Mod 75 + 48)
        Next
        strText = Join(strArray, Delimiter)
        Erase strArray
        ' Native Split()
        QueryPerformanceCounter curStart
        strArray = Split(strText, Delimiter)
        QueryPerformanceCounter curStop
        dblTime(1) = dblTime(1) + CDbl((curStop - curStart) / dblFrequency)
        Erase strArray
        ' SplitEllis()
        QueryPerformanceCounter curStart
        strArray = SplitEllis(strText, Delimiter)
        QueryPerformanceCounter curStop
        dblTime(2) = dblTime(2) + CDbl((curStop - curStart) / dblFrequency)
        Erase strArray
        ' SplitDouble()
        QueryPerformanceCounter curStart
        strArray = SplitDouble(strText, Delimiter)
        QueryPerformanceCounter curStop
        dblTime(3) = dblTime(3) + CDbl((curStop - curStart) / dblFrequency)
        Erase strArray
    Next
    strMessage = strMessage & "Split(): " & Format(dblTime(1) * 100, "#,##0.00") & "ms (" & Format(ArraySize + 1, "#,##0") & " elements)" & vbCrLf
    strMessage = strMessage & "SplitEllis(): " & Format(dblTime(2) * 100, "#,##0.00") & "ms (" & Format(ArraySize + 1, "#,##0") & " elements)" & vbCrLf
    strMessage = strMessage & "SplitDouble(): " & Format(dblTime(3) * 100, "#,##0.00") & "ms (" & Format(ArraySize + 1, "#,##0") & " elements)" & vbCrLf
    Erase dblTime
    strText = ""
    Sample = strMessage
End Function

Note that you enter the array size you want to test into the textbox.

[anhn]

Ellis, you are really brilliance.

This is another not bad performance version. It gets very close to benchmark of SplitDouble(), but the code looks much simpler.

MaxArraySize = Len(pstrText) \ Len(pstrDelimiter)
(Note that it does not handle the Error when pstrDelimiter="")

Public Function SplitA(pstrText As String, pstrDelimiter As String) As String()
    Dim strBuffer() As String
    Dim lngIndex As Long
    Dim lngArraySize As Long
    Dim lngPos As Long
    Dim lngPrev As Long
    Dim lngDelLen As Long
    
    lngDelLen = Len(pstrDelimiter)
    lngArraySize = Len(pstrText) \ lngDelLen
    ReDim strBuffer(lngArraySize)
    
    lngPrev = 1
    For lngIndex = 0 To lngArraySize
        lngPos = InStr(lngPrev, pstrText, pstrDelimiter)
        If lngPos = 0 Then Exit For
        strBuffer(lngIndex) = Mid$(pstrText, lngPrev, lngPos - lngPrev)
        lngPrev = lngPos + lngDelLen
    Next
    strBuffer(lngIndex) = Mid$(pstrText, lngPrev)
    
    ReDim Preserve strBuffer(lngIndex)
    SplitA = strBuffer
    Erase strBuffer
End Function