Convertir une chaîne avec des caractères spéciaux en une châne alpha-numérique

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 912 fois - Téléchargée 29 fois

Contenu du snippet

C bien simple. Ça permet de convertir par exemple :
<
Qu'est ce que ça fait? Lol! c drôle!
>
en :
<
Qu%27est+ce+que+%E7a+fait%3F+Lol%21+c+dr%F4le%21
>
Pour l'utiliser, c'est pas très malin.
Pour coder :
<
quelque_chose=ToHex(quoi_convertir,"Dans une textbox?")
>
Pour décoder
<
quelque_chose=ToString(quoi_décoder)
>

Source / Exemple :


'La fonction en dessous permet de convertir une chaîne de caractères avec
'Des caractères spéciaux en une chaîne alpha-numérique avec des vals hexas pour remplacer
Function ToHex(str As String, Optional RemoveLastCRLF As Boolean) As String
Dim car As String, AscVal As Integer, buf As String, hexx As String
If RemoveLastCRLF = True Then 'Pour enlever le dernier CRLF pour les textboxs
str = StrReverse(str)
str = Replace(str, Chr(13), "", 1, 1)
str = Replace(str, Chr(10), "", 1, 1)
str = StrReverse(str)
End If
For i = 1 To Len(str)
car = Mid$(str, i, 1)
If car = " " Then
buf = buf & "+"
Else
AscVal = Asc(car)

If IsCarOK(AscVal) = True Then 'Caractère Alpha-Numérique?
buf = buf & car
Else
hexx = BaseConvert(CStr(AscVal), 10, 16) 'Il faut le convertir en Hexa (commençant par "%" (Couple de 2 caractères.Lettres de A à F ou chiffre de 0 à 9
If Len(hexx) < 2 Then hexx = "0" & hexx
buf = buf & "%" & hexx
End If

End If
Next
ToHex = buf
End Function

'Dit si le caractère est Alpha-Numérique
Function IsCarOK(AscVal As Integer) As Boolean
If AscVal > 63 And AscVal < 91 Then
IsCarOK = True
End If
If AscVal > 96 And AscVal < 123 Then
IsCarOK = True
End If
If AscVal > 47 And AscVal < 5 Then
IsCarOK = True
End If

If AscVal = 46 Or AscVal = 45 Then
IsCarOK = True
End If
End Function
'Convertit un chaine Alpha-Numérique en une chaine standard avec tout les caractères
Function ToString(str As String) As String
Dim car As String, buf As String, hexx As String
For i = 1 To Len(str)
car = Mid$(str, i, 1)
If car = "%" Then
If Len(str) - i + 1 > 2 Then
hexx = Mid$(str, i + 1, 2)
hexx = BaseConvert(hexx, 16, 10)
i = i + 2
buf = buf & Chr(hexx)
End If
Else
If car = "+" Then car = " "
buf = buf & car
End If
Next
ToString = buf
End Function
'================================================================
'PAS DE MOI. J'AI TROUVÉ ÇA SUR UN SITE ALLEMAND. Mais c hot!
'================================================================
'Binaire = 2
'Octal = 8
'Décimal = 10
'Héxadecimal = 16
Public Function BaseConvert(NumIn As String, BaseIn As Byte, BaseOut As Byte) As String

 

   Dim i As Integer, CurrentCharacter As String, CharacterValue As Integer
   Dim PlaceValue As Integer, RunningTotal As Double, Remainder As Double
   Dim BaseOutDouble As Double, NumInCaps As String

   If NumIn = "" Or BaseIn < 2 Or BaseIn > 36 Or BaseOut < 1 Or BaseOut > 36 Then
      'Keine Angabe oder ungültiges Zahlensystem
      BaseConvert = "Error"
      Exit Function
   End If

   NumInCaps = UCase(NumIn)

   PlaceValue = Len(NumInCaps)

   For i = 1 To Len(NumInCaps)
      PlaceValue = PlaceValue - 1
      CurrentCharacter = Mid$(NumInCaps, i, 1)
      CharacterValue = 0
      If Asc(CurrentCharacter) > 64 And Asc(CurrentCharacter) < 91 Then
         CharacterValue = Asc(CurrentCharacter) - 55
      End If

      If CharacterValue = 0 Then
         If Asc(CurrentCharacter) < 48 Or Asc(CurrentCharacter) > 57 Then
            BaseConvert = "Error"
            Exit Function
         Else
            CharacterValue = Val(CurrentCharacter)
         End If
      End If

      If CharacterValue < 0 Or CharacterValue > BaseIn - 1 Then
         BaseConvert = "Error"
         Exit Function
      End If
      RunningTotal = RunningTotal + CharacterValue * (BaseIn ^ PlaceValue)
   Next i

   Do
      BaseOutDouble = CDbl(BaseOut)
      Remainder = RunningTotal - (Int(RunningTotal / BaseOutDouble) * BaseOutDouble)
      RunningTotal = (RunningTotal - Remainder) / BaseOut

      If Remainder >= 10 Then
         CurrentCharacter = Chr$(Remainder + 55)
      Else
         CurrentCharacter = Right$(str$(Remainder), Len(str$(Remainder)) - 1)
      End If
      BaseConvert = CurrentCharacter & BaseConvert
   Loop While RunningTotal > 0
   End Function

Conclusion :


Alors?

A voir également

Ajouter un commentaire

Commentaires

Xya
Messages postés
103
Date d'inscription
lundi 8 juillet 2002
Statut
Membre
Dernière intervention
24 novembre 2005
-
Les conversion de et vers l'hexa sont gérées par VB... Et même si le code de changement de base était révolutionaire, utiliser la fonction intégrée à VB le rendrait plus court et accessible.

Function Hex(Number)
Membre de VBA.Conversion
Renvoie une chaîne représentant la valeur hexadécimale d'un nombre

Hex(255) = "&hFF"
CLng("&HFF") = 255
gabchampagne
Messages postés
216
Date d'inscription
mercredi 2 avril 2003
Statut
Membre
Dernière intervention
5 mai 2004
-
1- mes valeurs hexas doivent contenir 2 caractères seulement. Pas de "&" ni de "h". Je sais que hex("quoi") retourne une valeur hexa. Je le savais bien avant que tu me le dise. Mais c'est comment convertir la valeur hexa en une valeur décimale que je ne savais pas. Je vais essayer Cint à la place.
Xya
Messages postés
103
Date d'inscription
lundi 8 juillet 2002
Statut
Membre
Dernière intervention
24 novembre 2005
-
Pour avoir tes valeurs hexa préfixées de % avec Hex c'est pas la fin du monde:
buf = buf & IIf(IsCarOK(AscVal), car, Format(Hex(AscVal), "%@@"))
'Remplace:
If IsCarOK(AscVal) = True Then 'Caractère Alpha-Numérique?
' buf = buf & car
' Else
' 'hexx = BaseConvert(CStr(AscVal), 10, 16) 'Il faut le convertir en Hexa (commençant par "%" (Couple de 2 caractères.Lettres de A à F ou chiffre de 0 à 9
' 'If Len(hexx) < 2 Then hexx = "0" & hexx
' 'buf = buf & "%" & hexx
' End If

Ca devient moins lisible mais c'est toujours mieux que de trimballer une fonction d'une vingtaine de lignes alors qu'on peut faire bcp plus simple. Enfin, chacun ses habitudes de codage, si tu t'y retrouve, tant mieux!
gabchampagne
Messages postés
216
Date d'inscription
mercredi 2 avril 2003
Statut
Membre
Dernière intervention
5 mai 2004
-
OK. La, je vais mieux m'expliquer. POUR CONVERTIR, on peut utiliser HEX$. ÇA, JE LE SAVAIS DÉJÀ. mais pour décoder, ÇA MARCHE PAS. Donc, je me suis dit, pourquoi ne pas juste utiliser baseconvert. En même temps, ça présenterais cette fonction.
Xya
Messages postés
103
Date d'inscription
lundi 8 juillet 2002
Statut
Membre
Dernière intervention
24 novembre 2005
-
Désole, j'ai oublié de dire que pour décoder d'hexa en décimal il faut signaler à VB que c'est un nombre hexa:

hexx = CLng("&H" & hexx) 'ou CInt, Cxxx...
'au lieu de:
hexx = BaseConvert(hexx, 16, 10)
'où hexx est le nombre hexa sans préfixe

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.