I just can’t believe this kind of functionality isn’t built in but so it is. The code should be pretty straight forward and well commented.
A StringTokenizer is used to split a string of text up into smaller bits delimeted by the chosen delimeter. A StringTokenizer really shines when it comes to parsing comma-separated files or the like.
Feel free to use the code but please let me know if you do. The code is provided as-is and I accept no responsibility what so ever.
'*** Constants ***
Private Const STANDARD_DELIMETER$ = ";"
'/**
' * StringTokenizer class to help break a string into tokens. A token is the
' * string between delimeters (defaults to semi-colon). The class handles
' * lines ending in a delimeter if you set the EndingDelimeter property
' * to True.
' *
' * Standard usage:
' * 1. Dim a new StringTokenizer using the source to parse as an argument.
' * 2. (Optional) Change the delimeter using the Delimter property.
' * 3. (Optional) Change the EndingDelimeter property.
' * 4. Call the HasNextElement() method and the NextElement() functions to
' * loop the string.
' *
' * Example 1:
' * Dim t1 As New StringTokenizer(";123;456;789;")
' * While t1.HasNextElement()
' * Print t1.NextElement()
' * Wend
' *
' * Output:
' * -
' * - 123
' * - 456
' * - 789
' * -
' *
' * Example 2:
' * Dim t2 As New StringTokenizer(";123;456;789;")
' * t2.EndingDelimeter = True
' * While t2.HasNextElement()
' * Print t2.NextElement()
' * Wend
' *
' * Output:
' * -
' * - 123
' * - 456
' * - 789
' *
' * Example 3:
' * Dim t3 As New StringTokenizer("123;456%789;012")
' * t3.Delimeter = "%"
' * While t3.HasNextElement()
' * Print t3.NextElement()
' * Wend
' *
' * Output:
' * - 123;456
' * - 789;012
' *
' * @version 1.0 (16 December 2004)
' * @author lekkim@it-inspiration.dk
' * @author it-inspiration aps
' */
Public Class StringTokenizer
'declarations
Private pSource As String
Private pDelimeter As String
Private pStart As Long
Private pDelim As Long
Private pEndingDelimeter As Boolean
Public Sub New(source As String)
Me.pSource = source
Me.pStart = 0
Me.pDelim = 0
Me.pEndingDelimeter = False
Me.pDelimeter = STANDARD_DELIMETER
End Sub
Public Property Set EndingDelimeter As Boolean
Me.pEndingDelimeter = EndingDelimeter
End Property
Public Property Set Delimeter As String
Me.pDelimeter = Left(Delimeter, 1)
End Property
Public Function HasNextElement() As Boolean
'declarations
Dim index As Long
'does the source have contents
If Len(Me.pSource) = 0 Then
'nope - return false
HasNextElement = False
Exit Function
End If
'have we been looking for a delimeter before ?
If Me.pStart = 0 And Me.pDelim = 0 Then
'nope - does the source start with a delimeter ?
If Left(Me.pSource, 1) = Me.pDelimeter Then
'the first element is empty
Me.pDelim = 1
'set start
Me.pStart = 1
Else
'find the first delimeter
index = Instr(1, Me.pSource, Me.pDelimeter)
'did we find a delimeter
If index > 1 Then
'yes we did - set the index of the delimeter
Me.pDelim = index
'set start
Me.pStart = 1
Else
'no we didn't only one element
Me.pDelim = 0
Me.pStart = 1
End If
End If
'return true
HasNextElement = True
Exit Function
Else
'we have been looking before - move the pointers
Me.pStart = Me.pDelim + 1
'have we reached the end of the source string ?
If Me.pStart > Len(Me.pSource) Then
'yes we have - return false
HasNextElement = False
Exit Function
Elseif Me.pStart = Len(Me.pSource) Then
'see if the last character is a delimeter
If Right(Me.pSource, 1) = Me.pDelimeter Then
'the last character is a delimeter - should the class add
'an empty element at the end
If Me.pEndingDelimeter Then
'the lines end in a delimeter
HasNextElement = False
Else
'we should signal an empty element
Me.pDelim = Me.pStart
HasNextElement = True
End If
Else
'the is a one character element at the end
Me.pStart = Len(Me.pSource)
Me.pDelim = 0
HasNextElement = True
End If
Else
'just look for the next delimeter
index = Instr(Me.pStart, Me.pSource, Me.pDelimeter)
'did we find a delimeter
If index > Me.pStart Then
'we found a delimter
Me.pDelim = index
HasNextElement = True
Elseif index = 0 And Me.pStart < Len(Me.pSource) Then
'there is one more element
Me.pDelim = Len(Me.pSource)
HasNextElement = True
Else
'no more delimeters
HasNextElement = False
End If
End If
End If
End Function
Public Function NextElement() As String
'if the delimeter is 0 there is only one element to return
If Me.pDelim = 0 Then
NextElement = Mid(Me.pSource, Me.pStart)
Exit Function
Elseif Me.pDelim = Me.pStart Then
'return an empty element
NextElement = ""
Exit Function
Elseif Me.pDelim = Len(Me.pSource) Then
'does the source end with a delimeter
If Me.pEndingDelimeter Then
'the line is supposed to end with a delimeter so we remove it
NextElement = Mid(Me.pSource, Me.pStart, Len(Me.pSource) - Me.pStart)
Else
'the line should not end with a delimeter so if it does so we need to
'return the rest of the line minus 1
If Right(Me.pSource, 1) = Me.pDelimeter Then
NextElement = Mid(Me.pSource, Me.pStart, Len(Me.pSource) - Me.pStart)
Me.pDelim = Me.pDelim - 1
Else
NextElement = Mid(Me.pSource, Me.pStart)
End If
End If
Else
NextElement = Mid(Me.pSource, Me.pStart, Me.pDelim-Me.pStart)
End If
End Function
End Class