tototiti2008

Bonsoir tototiti2008
pour enrichir ta ressource ,je te propose ces deux fonctions qui te permettent d’écrire ou lire un fichier texte en utf-8 sans utiliser d'object externe ni librairie
cod c'est le texte a écrire et myfile c'est le chemin du fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
Sub SaveFileUTF_8(Cod, myFile)
    'patricktoulon
Dim x%, utf8Text() As Byte, BOM(2) As Byte, i%, charCode&, utf8Char() As Byte, utf8Index&, tempText() As Byte, j&


    BOM(0) = &HEF ' Définir le BOM pour UTF-8 (0xEF, 0xBB, 0xBF)
    BOM(1) = &HBB
    BOM(2) = &HBF

    ' Initialiser les tableaux
    ReDim utf8Text(0) ' Initialiser le tableau final avec 0 élément
    utf8Index = 0

    ' Encoder manuellement chaque caractère en UTF-8
    For i = 1 To Len(Cod)
        charCode = AscW(Mid(Cod, i, 1))
        Select Case charCode
            Case Is <= &H7F
                ' 1 octet: 0xxxxxxx
                ReDim utf8Char(0): utf8Char(0) = charCode
            Case Is <= &H7FF
                ' 2 octets: 110xxxxx 10xxxxxx
                ReDim utf8Char(1): utf8Char(0) = &HC0 Or ((charCode \ &H40) And &H1F): utf8Char(1) = &H80 Or (charCode And &H3F)
            Case Is <= &HFFFF
                ' 3 octets: 1110xxxx 10xxxxxx 10xxxxxx
                ReDim utf8Char(2)
                utf8Char(0) = &HE0 Or ((charCode \ &H1000) And &HF): utf8Char(1) = &H80 Or ((charCode \ &H40) And &H3F): utf8Char(2) = &H80 Or (charCode And &H3F)
            Case Else
                ' 4 octets: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
                ReDim utf8Char(3)
                utf8Char(0) = &HF0 Or ((charCode \ &H40000) And &H7): utf8Char(1) = &H80 Or ((charCode \ &H1000) And &H3F): utf8Char(2) = &H80 Or ((charCode \ &H40) And &H3F)
                utf8Char(3) = &H80 Or (charCode And &H3F)
        End Select

        ' Assurer que utf8Text a assez de place pour les nouveaux octets
        If utf8Index + UBound(utf8Char) > UBound(utf8Text) Then
            ReDim Preserve utf8Text(utf8Index + UBound(utf8Char))
        End If

        ' Copier les octets encodés dans utf8Text
        For j = LBound(utf8Char) To UBound(utf8Char)
            utf8Text(utf8Index) = utf8Char(j)
            utf8Index = utf8Index + 1
        Next j
    Next i

    ' Réduire la taille finale du tableau utf8Text
    ReDim Preserve utf8Text(utf8Index - 1)

    ' Ouvrir le fichier en mode binaire pour l'écriture
    x = FreeFile
    Open myFile For Binary Access Write As #x
    Put #x, , BOM ' Écrire le BOM dans le fichier
    Put #x, , utf8Text ' Écrire le texte UTF-8 dans le fichier
    Close #x ' Fermer le fichier
End Sub


Function ReadFile_UTF_8(filepath)
   'patricktoulon
 Dim fileNum&, fileContent() As Byte, fileSize&, utf8Index&, charCode&, text$, currentByte As Byte
    Dim tempLong1&, tempLong2&, tempLong3&, tempLong4 As Long
    ' Ouvrir le fichier en mode binaire pour la lecture

    fileNum = FreeFile
    Open filepath For Binary Access Read As #fileNum
    ' Obtenir la taille du fichier
    fileSize = LOF(fileNum)
    If fileSize > 0 Then ' Lire le contenu du fichier dans un tableau d'octets
        ReDim fileContent(fileSize - 1)
        Get #fileNum, , fileContent
    End If
    Close #fileNum ' Fermer le fichier

    ' Vérifier et sauter le BOM si présent
    If fileSize >= 3 Then
        If fileContent(0) = &HEF And fileContent(1) = &HBB And fileContent(2) = &HBF Then
            utf8Index = 3
        Else
            utf8Index = 0
        End If
    End If
    text = "" ' Initialiser la chaîne de résultat
    ' Décoder les octets UTF-8 en caractères Unicode
    Do While utf8Index < fileSize
        currentByte = fileContent(utf8Index)
        Select Case True
            Case (currentByte And &H80) = 0
                ' 1 octet: 0xxxxxxx
                charCode = currentByte
                utf8Index = utf8Index + 1
            Case (currentByte And &HE0) = &HC0
                ' 2 octets: 110xxxxx 10xxxxxx
                If utf8Index + 1 < fileSize Then
                    tempLong1 = (currentByte And &H1F) * &H40
                    tempLong2 = fileContent(utf8Index + 1) And &H3F
                    charCode = tempLong1 + tempLong2
                    utf8Index = utf8Index + 2
                Else
                    Exit Do
                End If
            Case (currentByte And &HF0) = &HE0
                ' 3 octets: 1110xxxx 10xxxxxx 10xxxxxx
                If utf8Index + 2 < fileSize Then
                    tempLong1 = (currentByte And &HF) * &H1000
                    tempLong2 = (fileContent(utf8Index + 1) And &H3F) * &H40
                    tempLong3 = fileContent(utf8Index + 2) And &H3F
                    charCode = tempLong1 + tempLong2 + tempLong3
                    utf8Index = utf8Index + 3
                Else
                    Exit Do
                End If
            Case (currentByte And &HF8) = &HF0
                ' 4 octets: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
                If utf8Index + 3 < fileSize Then
                    tempLong1 = (currentByte And &H7) * &H40000
                    tempLong2 = (fileContent(utf8Index + 1) And &H3F) * &H1000
                    tempLong3 = (fileContent(utf8Index + 2) And &H3F) * &H40
                    tempLong4 = fileContent(utf8Index + 3) And &H3F
                    charCode = tempLong1 + tempLong2 + tempLong3 + tempLong4
                    utf8Index = utf8Index + 4
                Else
                    Exit Do
                End If
            Case Else
                ' Octet non valide, passer au suivant
                utf8Index = utf8Index + 1
                GoTo NextChar
        End Select
        text = text & ChrW(charCode) ' Ajouter le caractère décodé à la chaîne de résultat
NextChar:
Loop
ReadFile_UTF_8 = text ' return du texte
End Function

patrick

Merci patmeziere,
je regarde ça et je vois pour l'ajouter au fichier en te citant

Voilà, j'ai mis le fichier à jour, intègre maintenant ton code en méthode 4 (légèrement adapté pour correspondre aux autres exemples)