[VB6] SplitEx - An Enhanced Split Function

[fafalone]

This is my first contribution to the code bank, so be nice

SplitEx is an enhanced version of the basic Split function. It accepts an array of multiple delimiters. Parentheses and brackets, () [] {}, can be specified among the delimiters and what's inside them will be returned as one of the results; since I wasn't sure about usage scenarios, optional arguments indicate whether the parentheses or brackets should be retained around the contents. This function is not intended to be high performance.

Inputs
sz As String - The string that is to be split.
dlms As Variant - Array of delimiters
Optional lLimit As Long - Number of results to return
Optional comp As VbCompareMethod - If a delimiter contains letters, this determines the comparison used to match it.
Optional bTruncateLimit As Boolean - Normally, if a limit is specified, the remainder of the string is the last result. Setting this option to True will instead truncate the rest of the string, returning only the first lLimit number of results.
Optionals bRParen, bRBrack1, bRBrack2 As Booleans - Whether to retain the parentheses or brackets around the respective results. False by default.

Output: Variant array containing results.

Public Function SplitEx( _
                        sz As String, _
                        dlms As Variant, _
                        Optional lLimit As Long = 0, _
                        Optional comp As VbCompareMethod = vbBinaryCompare, _
                        Optional bTruncateLimit As Boolean = False, _
                        Optional bRParen As Boolean = False, _
                        Optional bRBrack1 As Boolean = False, _
                        Optional bRBrack2 As Boolean = False _
                        ) As Variant
'Splits a string with an array of delimiters
'Also allows an option to split by pairs () [] {}
'with a further option to retain those characters
'when splitting
Dim i As Long, j As Long, k As Long, c As Long, st As Long
Dim szPart As String
Dim ar As Variant
Dim szDelims As String
Dim bParen As Boolean
Dim bBrack1 As Boolean
Dim bBrack2 As Boolean

For i = LBound(dlms) To UBound(dlms)
    If (dlms(i) = "(") Or (dlms(i) = "()") Then
        bParen = True
        dlms(i) = ""
    End If
    If (dlms(i) = "[") Or (dlms(i) = "[]") Then
        bBrack1 = True
        dlms(i) = ""
    End If
    If (dlms(i) = "{") Or (dlms(i) = "{}") Then
        bBrack2 = True
        dlms(i) = ""
    End If
Next i

szDelims = Join(dlms)

szPart = ""
ReDim ar(0)
c = 0

For i = 1 To Len(sz)
If (lLimit > 0) And (UBound(ar) = lLimit - 1) And (i < Len(sz)) And (bTruncateLimit = False) Then
    ar(c) = Mid(sz, i)
    Exit For
ElseIf (lLimit > 0) And (UBound(ar) = lLimit) And (i < Len(sz)) And (bTruncateLimit = True) Then
    Exit For
End If
    If bParen And (Mid(sz, i, 1) = "(") Then
        If szPart <> "" Then
            ar(c) = szPart
            c = c + 1
            szPart = ""
            ReDim Preserve ar(c)
        End If
        j = InStr(i + 1, sz, ")")
        If j - (i + 1) > 0 Then
            For k = i + 1 To j - 1
                szPart = szPart & Mid(sz, k, 1)
            Next k
            If bRParen Then
                szPart = "(" & szPart & ")"
            End If
            ar(c) = szPart
            c = c + 1
            szPart = ""
            ReDim Preserve ar(c)
            i = j
            GoTo nxt
        End If
    End If
    If bBrack1 And (Mid(sz, i, 1) = "[") Then
        If szPart <> "" Then
            ar(c) = szPart
            c = c + 1
            szPart = ""
            ReDim Preserve ar(c)
        End If
        j = InStr(i + 1, sz, "]")
        If j - (i + 1) > 0 Then
            For k = i + 1 To j - 1
                szPart = szPart & Mid(sz, k, 1)
            Next k
            If bRBrack1 Then
                szPart = "[" & szPart & "]"
            End If
            ar(c) = szPart
            c = c + 1
            szPart = ""
            ReDim Preserve ar(c)
            i = j
            GoTo nxt
        End If
    End If
    If bBrack2 And (Mid(sz, i, 1) = "{") Then
        If szPart <> "" Then
            ar(c) = szPart
            c = c + 1
            szPart = ""
            ReDim Preserve ar(c)
        End If
        j = InStr(i + 1, sz, "}")
        If j - (i + 1) > 0 Then
            For k = i + 1 To j - 1
                szPart = szPart & Mid(sz, k, 1)
            Next k
            If bRBrack2 Then
                szPart = "{" & szPart & "}"
            End If
            ar(c) = szPart
            c = c + 1
            szPart = ""
            ReDim Preserve ar(c)
            i = j
            GoTo nxt
        End If
    End If
    If (InStr(1, szDelims, Mid(sz, i, 1), comp)) And ((szPart <> "") Or (UBound(ar) > 0)) Then
        If szPart <> "" Then
        ar(c) = szPart
        c = c + 1
        szPart = ""
        ReDim Preserve ar(c)
        End If
    Else
        szPart = szPart & Mid(sz, i, 1)
    End If
nxt:
Next i

If szPart <> "" Then
    ar(UBound(ar)) = szPart
Else
    If CStr(ar(UBound(ar))) = "" Then
        ReDim Preserve ar(UBound(ar) - 1)
    End If
End If


SplitEx = ar

End Function