( 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