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

Commenter

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

S'inscrire maintenant

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.

Du même auteur (gabchampagne)