stringTokenIzer autre forme

[oguruma]

merci à son auteur

Code : Tout sélectionner


Public Class StringTokenizer As Enumeration
   ' FIXME does not work correctly when setting returnDelimiters = true
   delimiters As Variant
   returnDelimiters As Variant
   currentPos As Long
   maxPos As Long
   newPos As Long
   s As String
   
   Public Sub new(s As String)
      Me.s = s
      maxPos = Len(s)
      currentpos = 1
      newPos = -1
      Redim delimiters(0 To 4)
      delimiters(0) = " "      ' Space
      delimiters(1) = Chr(9)    ' Tab / Tabulator / Horizontal tab
      delimiters(2) = Chr(10)   ' New Line / Line Feed / NL / LF
      delimiters(3) = Chr(12)   ' Form Feed / New Page / FF / NP
      delimiters(4) = Chr(13)   ' Carriage Return / CR
      returnDelimiters = False
   End Sub
   
   Public Sub setDelimiters(delimiter As Variant)
      On Error Goto handleError
      
      If Isarray(delimiter) Then
         Forall d In delimiter
            If Not (Typename(d) = "STRING") _
            Then Error 2000, "Illegal argument [" & Typename(d) & "]"
         End Forall
         delimiters = delimiter
      Else
         If Not (Typename(delimiter) = "STRING") _
         Then Error 2000, "Incorrect type [" & Typename(delimiters) & "]"
         Redim delimiters(0 To 0)
         delimiters(0) = delimiter
      End If
      Exit Sub
handleError:
      Error Err, Typename(Me) & "." & Lsi_info(2) & ":" & Erl & "|" & Error
   End Sub
   
   Public Sub setReturnDelimiters(returnDelimiters As Variant)
      If Not Typename(returnDelimiters) = "BOOLEAN" _
      Then Error 2000, "Invalid argument type [" & Typename(returnDelimiters) _
      & "]. Must be BOOLEAN."
      Me.returnDelimiters = returnDelimiters
   End Sub
   
   Private Function skipDelimiters(startPos As Long) As Long
      ' FIXME this MUST be rewritten with nicer code...
      On Error Goto handleError
      Dim pos As Long
      pos = startPos
      skipDelimiters = pos
      Dim delimiterPos As Long
      delimiterPos = 0
      
      If returnDelimiters Then Exit Function
      
      Do While pos < maxPos
         Forall delimiter In delimiters
            If Mid(s, pos, Len(delimiter)) = delimiter Then
               delimiterPos = pos
               pos = pos + Len(delimiter) - 1
               Exit Forall
            End If
         End Forall
         
         If delimiterPos = 0 Then Exit Do
         delimiterPos = 0
         pos = pos + 1
      Loop
      skipDelimiters = pos
      Exit Function
handleError:
      Error Err, Typename(Me) & "." & Lsi_info(2) & ":" & Erl & "|" & Error
   End Function
   
   Private Function scanToken(startPos As Long) As Long
      On Error Goto handleError
      Dim pos As Long
      Dim delimiterPos As Long
      Dim tmp As Long
      pos = startPos
      delimiterPos = startPos
      Do While pos < maxPos
         Forall delimiter In delimiters
            tmp = Instr(pos, s, delimiter)
            
            If (delimiterPos = startPos) And (tmp > 0) _
            Then delimiterPos = tmp
            If (tmp > 0) And (tmp < delimiterPos) _
            Then delimiterPos = tmp
         End Forall
         
         If delimiterPos > startPos Then Exit Do
         pos = pos + 1
      Loop
      If delimiterPos = startPos _
      Then delimiterPos = maxPos
      scanToken = delimiterPos
      Exit Function
handleError:
      Error Err, Typename(Me) & "." & Lsi_info(2) & ":" & Erl & "|" & Error
   End Function
   
   Public Function hasMoreElements() As Variant
      On Error Goto handleError
      newPos = skipDelimiters(currentPos)
      hasMoreElements = (newPos < maxPos)
      Exit Function
handleError:
      Error Err, Typename(Me) & "." & Lsi_info(2) & ":" & Erl & "|" & Error
   End Function
   
   Public Function nextElement() As Variant
      On Error Goto handleError
      If newPos > 0 Then
         currentPos = newPos
      Else
         currentPos = skipDelimiters(currentPos)
      End If
      newPos = -1
      If currentPos >= maxPos Then Error 2000, "Index out of bounds"
      Dim start As Long
      start = currentPos
      currentPos = scanToken(currentPos)
      
      If currentPos = maxPos Then currentPos = maxPos + 1
      nextElement = Mid(s, start, currentPos - start)
      Exit Function
handleError:
      Error Err, Typename(Me) & "." & Lsi_info(2) & ":" & Erl & "|" & Error
   End Function
End Class