GESTION CHAÎNES DE CARACTÈRES : "TOKEN"

'Fonctions "TOKEN" ("marque") : fonctions de gestion de chaînes de caractères codées en VB6 par Tim alias HeXoR (hexor@wanadoo.fr - hexor47@hotmail.com) :)
'AddTok(...) ; DelTok(...) ; FindTok(...); GetTok(...) ; InsTok(...) ; IsTok(...) ; NumTok(...) ; PutTok(...) ; RemTok(...) ; RepTok(...) ; TrimTok(...)
'Dernière mise à jour le 05/03/2004 à 14h17 GMT+1
'Attention il est fortement conseillé d'insérer toutes les fonctions et non pas seulement celle qui vous intéresse car chaque de fonction a besoin des autres fonctions (à part TrimTok(...))


Public Function AddTok(chaine As String, add As String, char As String)
AddTok = TrimTok(chaine, char) & char & add
End Function

Public Function DelTok(chaine As String, nb As Integer, char As String)
Dim x As Integer
Dim result As String
chaine = TrimTok(chaine, char)
While x < nb
result = result & char & GetTok(chaine, x, char)
x = x + 1
Wend
While x < NumTok(chaine, char)
x = x + 1
result = result & char & GetTok(chaine, x, char)
Wend
DelTok = TrimTok(result, char)
End Function

Public Function FindTok(chaine As String, ch As String, nb As Integer, char As String)
Dim y As Integer
Dim x As Integer
chaine = TrimTok(chaine, char)
'y = 0
While y < nb
x = x + 1
If GetTok(chaine, x, char) = ch And nb = 1 Then FindTok = x
If GetTok(chaine, x, char) = ch Then y = y + 1
If y = nb Then FindTok = x
Wend
End Function

Public Function GetTok(chaine As String, nb As Integer, char As String)
Dim x, y, d As Integer
chaine = TrimTok(chaine, char)
x = 1
Do
y = y + 1
If Mid(chaine, y, 1) = char Then x = x + 1
Loop While x < nb And y <= Len(chaine)
d = IIf(nb = 1, y, y + 1)
y = y + 1
While Mid(chaine, y, 1) <> char And y <= Len(chaine)
y = y + 1
Wend
GetTok = Mid(chaine, d, (y - d))
End Function

Public Function InsTok(chaine As String, ins As String, nb As Integer, char As String)
Dim x As Integer
Dim result As String
chaine = TrimTok(chaine, char)
While x < (nb - 1)
x = x + 1
result = result & char & GetTok(chaine, x, char)
Wend
result = result & char & ins
While x < NumTok(chaine, char)
x = x + 1
result = result & char & GetTok(chaine, x, char)
Wend
InsTok = TrimTok(result, char)
End Function

Public Function IsTok(chaine As String, ch As String, char As String)
Dim x As Integer
Dim y As Boolean
chaine = TrimTok(chaine, char)
For x = 1 To NumTok(chaine, char)
If GetTok(chaine, x, char) = ch Then
y = True
IsTok = y
End If
Next x
IsTok = y
End Function

Public Function NumTok(chaine As String, char As String)
Dim x, y As Integer
chaine = TrimTok(chaine, char)
x = 1
For y = 1 To Len(chaine)
If Mid(chaine, y, 1) = char Then x = x + 1
Next y
NumTok = x
End Function

Public Function PutTok(chaine As String, ch As String, nb As Integer, char As String)
Dim x As Integer
Dim result As String
chaine = TrimTok(chaine, char)
While x < nb
result = result & char & GetTok(chaine, x, char)
x = x + 1
Wend
result = result & char & ch
While x < NumTok(chaine, char)
x = x + 1
result = result & char & GetTok(chaine, x, char)
Wend
PutTok = TrimTok(result, char)
End Function

Public Function RemTok(chaine As String, ch As String, nb As Integer, char As String)
chaine = TrimTok(chaine, char)
RemTok = DelTok(chaine, FindTok(chaine, ch, nb, char), char)
End Function

Public Function RepTok(chaine As String, ch As String, nouv As String, nb As Integer, char As String)
chaine = TrimTok(chaine, char)
RepTok = PutTok(chaine, nouv, FindTok(chaine, ch, nb, char), char)
End Function

Public Function TrimTok(chaine As String, char As String)
Dim x As Integer
a:
If Left(chaine, 1) = char Then chaine = Right(chaine, (Len(chaine) - 1))
If Right(chaine, 1) = char Then chaine = Left(chaine, (Len(chaine) - 1))
If Left(chaine, 1) = char Or Right(chaine, 1) = char Then GoTo a
While x < Len(chaine)
x = x + 1
If Mid(chaine, x, 1) = char And Mid(chaine, x, 1) = Mid(chaine, x + 1, 1) Then
chaine = Left(chaine, x) & Right(chaine, (Len(chaine) - x - 1))
x = x - 1
End If
Wend
TrimTok = chaine
End Function