Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1687 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [Code inside] Conversion entre UTF-8 et ANSI (utf8 ansi vb)

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[Code inside] Conversion entre UTF-8 et ANSI (utf8 ansi vb)

n°1236876
Cyberpat92
Posté le 02-11-2005 à 20:30:56  profilanswer
 

Voilà, j'avais besoin de convertir de l'UTF-8 en ANSI et après pas mal de recherches je n'ai rien trouvé de concluant, donc je l'ai codé à partir de la RFC. Je dépose le code ici dans l'espoir que ça puisse un jour servir à quelqu'un. Code source libre de droits.
 
EDIT: mise à jour de la fonction isUTF8 par une version plus fiable.
EDIT2: nouvelle mise à jour pour corriger un bug dans le décodage UTF8 et implémentation de la norme complète (sur 4 octets).
 
Code de test :
 
Sub main()
    Debug.Print Encode_UTF8("œ" )
    Debug.Print Decode_UTF8(Encode_UTF8("œ" ))
    Debug.Print Decode_UTF8("éa" )
    Debug.Print isUTF8("éa" )
    Debug.Print isUTF8("abcde" )
End Sub
 
 
Code principal :
 
Option Explicit
 
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
'   --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function Encode_UTF8(astr)
    Dim c
    Dim n
    Dim utftext
     
    utftext = ""
    n = 1
    Do While n <= Len(astr)
        c = AscW(Mid(astr, n, 1))
        If c < 128 Then
            utftext = utftext + Chr(c)
        ElseIf ((c >= 128) And (c < 2048)) Then
            utftext = utftext + Chr(((c \ 64) Or 192))
            utftext = utftext + Chr(((c And 63) Or 128))
        ElseIf ((c >= 2048) And (c < 65536)) Then
            utftext = utftext + Chr(((c \ 4096) Or 224))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        Else ' c >= 65536
            utftext = utftext + Chr(((c \ 262144) Or 240))
            utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
            utftext = utftext + Chr((((c \ 64) And 63) Or 128))
            utftext = utftext + Chr(((c And 63) Or 128))
        End If
        n = n + 1
    Loop
    Encode_UTF8 = utftext
End Function
 
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
'   --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function Decode_UTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
    Dim unitext
     
    If isUTF8(astr) = False Then
        Decode_UTF8 = astr
        Exit Function
    End If
     
    unitext = ""
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
         
        If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
            n = n + 4
        ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
            n = n + 3
        ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
            unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
            n = n + 2
        ElseIf (c0 And 128) = 128 Then
            unitext = unitext + ChrW(c0 And 127)
            n = n + 1
        Else ' c0 < 128
            unitext = unitext + ChrW(c0)
            n = n + 1
        End If
    Loop
 
    Decode_UTF8 = unitext
End Function
 
'   Char. number range  |        UTF-8 octet sequence
'      (hexadecimal)    |              (binary)
'   --------------------+---------------------------------------------
'   0000 0000-0000 007F | 0xxxxxxx
'   0000 0080-0000 07FF | 110xxxxx 10xxxxxx
'   0000 0800-0000 FFFF | 1110xxxx 10xxxxxx 10xxxxxx
'   0001 0000-0010 FFFF | 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
Public Function isUTF8(astr)
    Dim c0, c1, c2, c3
    Dim n
     
    isUTF8 = True
    n = 1
    Do While n <= Len(astr)
        c0 = Asc(Mid(astr, n, 1))
        If n <= Len(astr) - 1 Then
            c1 = Asc(Mid(astr, n + 1, 1))
        Else
            c1 = 0
        End If
        If n <= Len(astr) - 2 Then
            c2 = Asc(Mid(astr, n + 2, 1))
        Else
            c2 = 0
        End If
        If n <= Len(astr) - 3 Then
            c3 = Asc(Mid(astr, n + 3, 1))
        Else
            c3 = 0
        End If
         
        If (c0 And 240) = 240 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
                n = n + 4
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 224) = 224 Then
            If (c1 And 128) = 128 And (c2 And 128) = 128 Then
                n = n + 3
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 192) = 192 Then
            If (c1 And 128) = 128 Then
                n = n + 2
            Else
                isUTF8 = False
                Exit Function
            End If
        ElseIf (c0 And 128) = 0 Then
            n = n + 1
        Else
            isUTF8 = False
            Exit Function
        End If
    Loop
End Function


Message édité par Cyberpat92 le 12-02-2007 à 13:50:28
mood
Publicité
Posté le 02-11-2005 à 20:30:56  profilanswer
 

n°1277469
granturism​o1
Posté le 05-01-2006 à 11:01:28  profilanswer
 

Un tout grand merci pour ce code, il m'a bien dépanné  :D

n°1513465
Cyberpat92
Posté le 12-02-2007 à 09:37:26  profilanswer
 

Y'a pas de quoi. Je viens de faire un update pour corriger un bug dans le décodage UTF8. Au passage la nouvelle version implémente l'ensemble de la norme UTF-8 (sur 4 octets). :)

n°1548020
r0ckw1ld3r
Posté le 24-04-2007 à 13:43:37  profilanswer
 

Yes, tu viens de me faire gagner pas mal de temps! Merci bien ;)

n°1802866
Felinel
Graou !
Posté le 21-10-2008 à 17:06:54  profilanswer
 

Presque 3 ans après, ce code m'a été très utile. Merci !
 
NB : Ce code passe parfaitement en VBS !


Message édité par Felinel le 21-10-2008 à 17:09:12
n°1869231
Babynus
Posté le 03-04-2009 à 14:23:31  profilanswer
 

Un grand merci.
C'est exactement ce que je cherchais.
 
Et un grand non-merci à Billou pour ne pas avoir implémenté cette fonction en natif VB / VBA. :kaola:  
 
Heureusement cyberpat92 était là !  :love:

n°1956593
Flying Liz​ard
lurkeur convalescent
Posté le 10-01-2010 à 19:53:50  profilanswer
 

Babynus a écrit :

Un grand merci.
C'est exactement ce que je cherchais.
 
Et un grand non-merci à Billou pour ne pas avoir implémenté cette fonction en natif VB / VBA. :kaola:  
 
Heureusement cyberpat92 était là !  :love:


 
+1

n°1965915
Khafar31
Posté le 14-02-2010 à 19:20:05  profilanswer
 

Et dire que je me suis emm****dé pendant des journées entières à chercher comment passer ou récupérer les données passées via des appels Ajax...
 
Que Cyberpat92 soit célébré dans la galaxie entière !
(non, je déconne, la Terre suffira...)
 
Merci encore !

n°2299198
chcoust
Posté le 13-04-2017 à 16:05:26  profilanswer
 

Bonjour,  
 
Pour info, 12 ans après, ce code m'a bien aidé !

n°2299263
Marc L
Posté le 17-04-2017 à 15:50:20  profilanswer
 

 
            Bonjour,
 
            pour info dans le cas d'un fichier texte alors utiliser  ADODB.Stream  comme documenté sur MSDN …
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [Code inside] Conversion entre UTF-8 et ANSI (utf8 ansi vb)

 

Sujets relatifs
probleme avec un code[C#] Protection mot de passe dans le code
Afficher le contenu d'1 fichier XML dans un flash - Master NooB insideProblème d'execution d'un logiciel compilé. (Noob inside)
latin1 vs/ utf8[RESOLU] pb de "unchecked conversion" avec generic
"ton code est tout pourri"indentation du code dans visual basic
Afficher du code dans une page HTML : question de sémantiqueAlgo Conversion Notation Infixe en Notation Polonaise Inverse
Plus de sujets relatifs à : [Code inside] Conversion entre UTF-8 et ANSI (utf8 ansi vb)



Copyright © 1997-2016 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR