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