( Sources convertis en 6 couleurs avec mon programme VB to HTML)
Option Explicit
'===========================================================================
' fredjust
' fredjust@hotmail.com
' Active Visual Basic
' http://www.fredjust.com
'===========================================================================
'===========================================================================
' CE MODULE GERE UNE CHAINE COMME UNE SECTION D UN FICHIER INI
' IL EST POSSIBLE D AJOUTER DE LIRE ET DE SUPPRIMER DES VALEURS
' CELA PERMET DE PLACER PLUSIEURS VALEURS DANS UN SEUL TAG
'
' EXEMPLE si
' tempo="|NOM=Just|PRENOM=Fred|AGE=27|MAIL=fredjust@hotmail.com|"
'
' IL EST POSSIBLE DE RECUPERER LE NOM PAR tagReadValue(tempo,"nom")
'
' LA "CASE" POUR LES "NAME" EST IGNOREE (mais pas pour les "VALUE")
' tagReadValue(tempo,"Nom") RENVOIE AUSSI LE NOM
'
' PAR DEFAUT :
' LES DIFFERENTES VALEURS SONT SEPAREES PAR DES | (Alt Gr + 6)
' LE SIGNE := EST UTILSER APRES CHAQUE NAME
' ! LES "NAME" ET LES "VALUE" TRANSMISENT NE DOIVENT PAS COMPORTER CES CARACTERES !
'
' IL EST POSSIBLE DE LES MODIFIER VIA la procedure tagInit
'===========================================================================
Private tagSigneEq As String
Private tagSeparator As String
'===========================================================================
' INITIALISE OU CHANGE LES CARATERES DE SEPARATIONS
'===========================================================================
Public Sub tagInit(Optional ByVal SigneEq As String = ":=", _
Optional ByVal Separator As String = "|")
tagSigneEq = SigneEq
tagSeparator = Separator
End Sub
'===========================================================================
' ECRIT OU REMPLACE LA VARIABLE DE NOM "NAME"
' RENVOIE LA CHAINE ENTIERE MODIFIEE
'===========================================================================
Public Function tagWriteValue(ByVal TheTag As String, ByVal Name As String, _
ByVal Value As String) As String
Dim Where As Long
Dim Tempo As String
'si c'est la premier valeur insérée
If InStr(1, TheTag, tagSeparator) = 0 Then TheTag = tagSeparator
' recherche si cette variable existe deja
Where = InStr(1, TheTag, tagSeparator & UCase(Name) & tagSigneEq)
If Where = 0 Then
' elle n'existe pas on l'ajoute
tagWriteValue = TheTag & UCase(Name) & tagSigneEq & Value & tagSeparator
Else
' elle existe on doit la remplacer
' on efface l'ancienne ...
Tempo = tagDeleteValue(TheTag, Name)
' ... on ajoute la nouvelle
tagWriteValue = Tempo & UCase(Name) & tagSigneEq & Value & tagSeparator
End If
End Function
'===========================================================================
' RENVOIE LA VALEUR DE LA VARIABLE DEMANDEE
'===========================================================================
Public Function tagReadValue(ByVal TheTag As String, ByVal Name As String, _
Optional ByVal Default As String = "") As String
Dim Where As Long
Dim debut As Long
Dim suivant As Long
' recherche la valeur
Where = InStr(1, TheTag, tagSeparator & UCase(Name) & tagSigneEq)
If Where = 0 Then
' elle n'existe pas on renvoie la valeur par defaut
tagReadValue = Default
Else
' elle existe on l'extrait et on la renvoie
debut = Where + Len(Name) + Len(tagSigneEq) + Len(tagSeparator)
suivant = InStr(Where + Len(tagSeparator), TheTag, tagSeparator)
tagReadValue = Mid$(TheTag, debut, _
suivant - debut)
End If
End Function
'===========================================================================
' EFFACE UNE VARIABLE
'===========================================================================
Public Function tagDeleteValue(ByVal TheTag As String, _
ByVal Name As String) As String
Dim Where As Long
' recherche la valeur
Where = InStr(1, TheTag, tagSeparator & UCase(Name) & tagSigneEq)
If Where <> 0 Then
' elle existe on la supprime
TheTag = Replace$(TheTag, _
Mid$(TheTag, Where + Len(tagSeparator), InStr(Where + 1, TheTag, tagSeparator) - Where), _
"")
tagDeleteValue = TheTag
Else
' elle n'existe pas => rien a faire
tagDeleteValue = TheTag
End If
End Function