[VBA] Une fonction qui détermine si la chaîne de caractères du système de fichiers UTF-8 est de 255 ou moins et une fonction qui compte la chaîne de caractères de UTF-8 en octets.

De Ansi à UTF-8

L'angoisse commence par la méthode de comptage en ANSI Une fonction pour créer facilement ansiLenB Excel avant de démarrer Access Faire correspondre la paire de substituts UTF-16LE À propos de la paire de substituts de fouille Obtenez le code de caractère UTF-16 UTF-8 SJis pour tous les caractères à l'aide d'Excel pour Microsoft 365 VBA Win32 Api and Spill Et maintenant

Problèmes avec la longueur du nom de fichier et le code de caractère Blog du président du programme

Premièrement, il y a un problème avec le code de caractère. Sous Linux et MacOS, le nom du fichier est généralement UTF-8. Windows semble être UNICODE en NTFS, mais il semble être Shift_JIS (CP932) dans l'application (car je ne suis pas si intéressé ...). Par conséquent, lors du durcissement avec ZIP, si vous durcissez avec UTF-8 tel quel, les caractères seront brouillés. Cela ne peut pas être aidé, donc si vous créez de force un fichier avec le nom de fichier CP932 sous Linux ou MacOS et le gelez avec ZIP, cela fonctionnera. Cependant, si vous créez un nom de fichier CP932 sur MacOS, il sera souvent plus lourd pour chaque système d'exploitation, donc Linux est meilleur. ..

Eh bien, si vous pensez que vous avez résolu le problème du code de caractère, cette fois le problème de la longueur du nom de fichier se posera. Sous Windows, il semble contenir jusqu'à 256 caractères, chemin compris, donc les noms de fichiers longs entraîneront une erreur. Il n'y a pas d'autre choix que de tronquer les noms de fichiers longs, mais la troncature des caractères ASCII est facile, mais la troncature des caractères multi-octets est fastidieuse. Si vous le coupez à un endroit approprié, les caractères seront déformés. Cela ne peut pas être aidé, donc en langage C, etc., cela ressemble à une conversion en caractères larges, à une troncature, puis à un retour en multi-octets.

Dans le passé, il y avait beaucoup de CP932 pour Windows et EUC pour UNIX, et dans de nombreux cas, il était possible de supposer que le japonais faisait 2 octets, mais avec la propagation d'Internet, des personnages du monde entier ont fini par coexister. En conséquence, le multi-octet n'est plus d'environ 2 octets et il est devenu difficile à gérer par moi-même. Il vaut mieux utiliser une bibliothèque qui gère les multi-octets docilement ... </ b>

Président ...

(Omis) Maintenant, vous pouvez enfin lui donner un nom de fichier que vous espérez pouvoir décompresser sous Windows. «Attendu» est dû au fait que la longueur du chemin est de 256 caractères maximum, elle peut donc être dépassée en fonction du répertoire à développer.

À propos, dans les systèmes d'exploitation UNIX tels que Linux, la longueur maximale du nom de fichier est de 255 octets. La longueur maximale du chemin est de 1023 octets (la limite lors du passage aux appels système), ce qui est considérablement plus facile à gérer que Windows. </ B>

Donc dans le cas d'un serveur Linux Le nom du fichier est Le code de caractère est UTF-8 255 caractères en demi-largeur Il se trouve que. Cette demi-largeur de 255 caractères signifie que les caractères pleine largeur sont de 85 caractères. En effet, si une demi-largeur est de 1 octet, elle est de 3 octets. De plus, la paire de substitution est de 4 octets. Il a été révélé ceci Obtenez le code de caractère UTF-16 UTF-8 SJis pour tous les caractères à l'aide d'Excel pour Microsoft 365 VBA Win32 Api and Spill Ce sera une feuille créée à partir de SheetMake2 ici. Dans la plage de précision de jugement de cette API Win32, la chaîne de caractères est convertie en binaire UTF-8. Ceci est utilisé pour compter en octets. Cette fois également, nous utiliserons l'API Win32. Le code ci-dessous est écrit en plus du précédent.

#If VBA7 Then
Declare PtrSafe Function MessageBox Lib "user32" Alias "MessageBoxW" _
    (ByVal hwnd As LongPtr, ByVal lpText As LongPtr, _
     ByVal lpCaption As LongPtr, ByVal wType As Long) As Long
Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
Declare PtrSafe Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 Declare PtrSafe Function GetSystemDirectory Lib "Kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 Declare PtrSafe Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32" (ByVal lpPathName As Long) As Long
' Set rrent Directory
Private Declare PtrSafe Function SetCurrentDirectory Lib "Kernel32" Alias _
                            "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
'Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32.dll" Alias "SetCurrentDirectoryW" (ByVal lpPathName As Long) As Long
'Private Declare PtrSafe Function SetCurrentDirectory Lib "kernel32.dll" Alias "SetCurrentDirectoryA" (ByVal lpPathName As Long) As Long

#Else
'Ajout de l'instruction Declare suivante au module standard
Declare Function MessageBox Lib "user32" Alias "MessageBoxW" _
    (ByVal hwnd As Long, ByVal lpText As Long, _
     ByVal lpCaption As Long, ByVal wType As Long) As Long
Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" _
 Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
 ByVal nSize As Long) As Long
#End If
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32.dll" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cchMultiByte As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long) As Long

Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32.dll" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cchMultiByte As Long, _
    ByVal lpDefaultChar As LongPtr, _
    ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 = 65001

Private Const ERROR_INSUFFICIENT_BUFFER = 122&

'UFT-Code pour la paire de sarrogates 16LE
Sub TestSarrogatePair()
' For Excel
'En supposant que l'ActiveCell contient un caractère de paire de substitution
'Pour tester, rechercher son substitut supérieur et inférieur
'Afficher avec MsgBoxEx
'Pour cette raison, utilisez l'API Windows
' UTF-16 LE ,Bb pour BE(0) bb(1) bb(2) bb(3)devenir
Dim b As String
Dim bb() As Byte
Dim Text As String
b = ActiveCell.Value
bb = b
Debug.Print "AscW Result(Dec -> Hex)" & vbTab & Hex(AscW(b))
Debug.Print "&H" & Hex(bb(1)) & Hex(bb(0))
Debug.Print "&H" & Hex(bb(3)) & Hex(bb(2))
Text = ChrW("&H" & Hex(bb(1)) & Hex(bb(0))) & ChrW("&H" & Hex(bb(3)) & Hex(bb(2)))
Debug.Print "ChrW(" & "&H" & Hex(bb(1)) & Hex(bb(0)) & ") & ChrW(&H" & Hex(bb(3)) & Hex(bb(2)) & ")"
MsgBoxEx Text
End Sub
'UTF-16 LE
Function UTF16Sarrogate(s As String)
Dim bb() As Byte
If IsUpperSarrogateCharacter(s) And IsLowerSarrogateCharcter(s) Then
bb = s
UTF16Sarrogate = "0x" & CStr(Hex(bb(1)) & Hex(bb(0))) & " " & "0x" & CStr(Hex(bb(3)) & Hex(bb(2)))
Exit Function
Else
UTF16Sarrogate = ""
End If
End Function
Function IsUpperSarrogateCharacter(s As String)
If Hex(AscW(s)) >= Hex(&HD800) And Hex(AscW(s)) <= Hex(&HDBFF) Then
IsUpperSarrogateCharacter = True: Exit Function
Else
IsUpperSarrogateCharacter = False: Exit Function
End If
End Function
Function IsLowerSarrogateCharcter(s As String)
Dim bb() As Byte
If IsUpperSarrogateCharacter(s) = True Then
bb = s
'Debug.Print Hex("&H" & bb(3) & bb(2))
If Hex("&H" & bb(3) & bb(2)) <= Hex(&HDC00) And Hex("&H" & bb(3) & bb(2)) <= Hex(&HDFFF) Then
IsLowerSarrogateCharcter = True: Exit Function
Else
IsLowerSarrogateCharcter = False: Exit Function
End If
End If
End Function
Function VBAAscW(s As String)
If AscW(s) < 0 Then
VBAAscW = AscW(s) + 65536: Exit Function
Else
VBAAscW = AscW(s): Exit Function
End If
End Function
' Shift-Jis
Function VBA_ASC(s As String)
If isSJIS(s) Then
VBA_ASC = Hex(Asc(s)): Exit Function
Else
VBA_ASC = "": Exit Function
End If
End Function
Function isSJIS(ByVal argStr As String) As Boolean
'https://excel-ubara.com/excelvba4/EXCEL_VBA_403.html
    Dim sQuestion As String
    sQuestion = Chr(63) '?:En cas de malentendu dans le caractère littéral
    Dim i As Long
    For i = 1 To Len(argStr)
        If Mid(argStr, i, 1) <> sQuestion And _
           Asc(Mid(argStr, i, 1)) = Asc(sQuestion) Then
            isSJIS = False
            Exit Function
        End If
    Next
    isSJIS = True
End Function
Function LenByteUTF8(ByRef s As String) As Long
    If Len(s) = 0 Then
        LenByteUTF8 = 0
        Exit Function
    End If
    Dim nBufferSize As Long
    Dim Ret() As Byte
    nBufferSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    ReDim Ret(0 To nBufferSize - 1)
    WideCharToMultiByte CP_UTF8, 0, StrPtr(s), Len(s), VarPtr(Ret(0)), nBufferSize, 0, 0
    LenByteUTF8 = UBound(Ret) + 1
End Function
Function IsLengthle255byteOnUTF8(s As String) As Boolean
'Il s'agit d'une version de test et est en cours de vérification.
' UTF-Convertir en 8 et attribuer au tableau d'octets pour compter le nombre
'Faux si supérieur à 255
'Lors de l'utilisation de cette fonction
' https://qiita.com/Q11Q/items/a2d61545d9e5c4e15f22
'Faites attention aux paramètres VBE
    If Len(s) = 0 Then
        IsLengthle255byteOnUTF8 = False
        Exit Function
    End If
    Dim nBufferSize As Long
    Dim Ret() As Byte
    Dim cnt As Long
    nBufferSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    ReDim Ret(0 To nBufferSize - 1)
    WideCharToMultiByte CP_UTF8, 0, StrPtr(s), Len(s), VarPtr(Ret(0)), nBufferSize, 0, 0
    cnt = UBound(Ret) + 1
    If cnt > 255 Then IsLengthle255byteOnUTF8 = False: Exit Function Else IsLengthle255byteOnUTF8 = True: Exit Function
End Function

Ajouter au module précédent. Ce que j'ai ajouté cette fois LenByteUTF8

Function LengthUTF8(s As String)
'Il s'agit d'une version de test et est en cours de vérification.
' UTF-Convertir en 8 et attribuer au tableau d'octets pour compter le nombre
'Faux si supérieur à 255
'Lors de l'utilisation de cette fonction
' https://qiita.com/Q11Q/items/a2d61545d9e5c4e15f22
'Faites attention aux paramètres VBE
    If Len(s) = 0 Then
        LengthUTF8 = 0
        Exit Function
    End If
    Dim nBufferSize As Long
    Dim Ret() As Byte
    Dim cnt As Long
    nBufferSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    ReDim Ret(0 To nBufferSize - 1)
    WideCharToMultiByte CP_UTF8, 0, StrPtr(s), Len(s), VarPtr(Ret(0)), nBufferSize, 0, 0
    cnt = UBound(Ret) + 1
    LengthUTF8 = cnt
End Function

Et IsLengthle 255byteOnUTF8 Est.

Function IsLengthle255byteOnUTF8(s As String) As Boolean
'Il s'agit d'une version de test et est en cours de vérification.
' UTF-Convertir en 8 et attribuer au tableau d'octets pour compter le nombre
'Faux si supérieur à 255
'Lors de l'utilisation de cette fonction
' https://qiita.com/Q11Q/items/a2d61545d9e5c4e15f22
'Faites attention aux paramètres VBE
    If Len(s) = 0 Then
        IsLengthle255byteOnUTF8 = False
        Exit Function
    End If
    Dim nBufferSize As Long
    Dim Ret() As Byte
    Dim cnt As Long
    nBufferSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    ReDim Ret(0 To nBufferSize - 1)
    WideCharToMultiByte CP_UTF8, 0, StrPtr(s), Len(s), VarPtr(Ret(0)), nBufferSize, 0, 0
    cnt = UBound(Ret) + 1
    If cnt > 255 Then IsLengthle255byteOnUTF8 = False: Exit Function Else IsLengthle255byteOnUTF8 = True: Exit Function
End Function

De la précédente àUTF8, vous pouvez voir comment compter en unités d'octets.

ReDim Ret(0 To nBufferSize - 1) Les unités d'octets sont comptées ici. Il peut être correct de le mettre tel quel, mais je ne connais pas le comportement de Win32API, donc je vais certainement l'attribuer au tableau. Ajoutez ensuite 1 au nombre d'éléments acquis par Ubound. Il peut être possible de définir ceci sur 1 lorsque Redim est utilisé au lieu de 0, mais comme ce tableau est inclus dans Win32Api, j'ai décidé qu'il ne devrait pas être changé.

Ce n'est pas la longueur du répertoire ou du fichier sur le serveur Windows

Comme indiqué dans le blog du président, c'est Linux, pas Windows, qui est censé contenir 255 caractères et 255 octets en demi-largeur en UTF-8, et la longueur du fichier du serveur Windows ne peut pas être mesurée avec cela.

La paire de substitution est de 4 octets

En comptant sur cette base, la paire de substitution consomme 4 octets et 4 caractères en demi-largeur. Même s'il ressemble à un caractère pleine largeur, 42 caractères sont considérés comme la limite. Si vous recherchez, vous trouverez diverses théories telles que 5 octets ou 6 octets, mais vous pouvez être touché. Selon les documents d'IBM, UTF-8 a un maximum de 4 octets. https://www.ibm.com/support/knowledgecenter/ja/SSEPGG_11.5.0/com.ibm.db2.luw.admin.nls.doc/doc/c0004816.html Par conséquent, le maximum est défini sur 4 octets. Et un exemple de 4 octets est une paire de substitution.

Octets et nombre de caractères

Cette fonction convertit la chaîne de caractères en octets UTF-8. Il semble donc que vous puissiez le remplacer par un code, qu'il soit pleine largeur ou demi-largeur et le rendre aussi long. En d'autres termes, la capacité est de 255 octets et le nombre de caractères est de 255, ils sont donc utilisés correctement dans le texte.

API Win32 et atouts

C'est certainement un code long, mais vous n'avez pas besoin de vous référer à ADODB. De plus, toUTF8 est converti en un tableau d'octets UTF-8, il serait donc inutile sans débordements. Cependant, il n'est valide que sur la feuille de calcul d'Excel, il est donc difficile de l'utiliser uniquement sur Excel. Étant donné que cette fonction modifie le nombre de caractères en nombre d'octets et détermine 255 caractères, elle peut être utilisée non seulement dans Excel mais également dans Access, Word, Publisehr Outlook.

Recommended Posts