AnsiからUTF-8へ

最初ANSIでのカウント方法から苦悩は始まり
Accessを始めるまえに簡単にパパッと作る関数ansiLenB Excelも
UTF-16LEのサロゲートペアにあい
発掘　サロゲートペアについて
 Excel for Microsoft 365 VBA Win32Apiとスピルを使いすべての文字のUTF-16 UTF-8 SJisの文字コードを取得する
そして今

ファイル名の長さと文字コードの問題プログラマー社長のブログ

まず、文字コードの問題があります。LinuxやMacOSでは、ファイル名は一般的にUTF-8です。WindowsはNTFSではUNICODEらしいのですが、アプリではShift_JIS(CP932)になるらしいです（あまり興味ないので・・・）。そのため、ZIPで固める際に、UTF-8のまま固めると文字化けしてしまいます。仕方ないので、LinuxやMacOSで無理矢理CP932のファイル名でファイルを作ってZIPで固めるとうまくいきます。が、MacOSでCP932のファイル名を作るとOSごと重くなることが多い気がするのでLinuxの方がマシです。。

さて、文字コードの問題をクリアーしたと思うと、今度はファイル名の長さの問題が立ちふさがります。Windowsではパスも含めて256文字までらしいので、長いファイル名はエラーになってしまいます。仕方ないので、長いファイル名は切り詰めるしかないのですが、ASCII文字の切り詰めは簡単ですが、マルチバイト文字の切り詰めは面倒です。適当なところで切ってしまうと文字化けしてしまいます。仕方ないので、C言語などではワイド文字に変換して切り詰めて、またマルチバイトに戻す感じになります。

昔はWindowsはCP932、UNIX系はEUCが多くて、どちらも日本語は2バイトという想定が使える場合が多かったのですが、インターネットが普及して世界各国の文字が共存するようになってきて、マルチバイトは2バイトどころではなくなってしまい、自力で何とかするのは大変になってしまいました。素直にマルチバイト処理ようのライブラリを使うのが良いでしょう・・・。

社長・・・

(中略)これでようやくWindowsで解凍できる見込みのファイル名にすることができます。「見込み」というのは、パスの長さが256文字までなので、展開するディレクトリによってはオーバーしてしまったりする可能性もあるためです。

ちなみに、LinuxなどのUNIX系OSでは、ファイル名の最大長は255バイト。パスの最大長は1023バイト（システムコールに渡す際の制限）と、Windowsよりはかなり扱いやすくなります

つまりLinuxサーバの場合
ファイル名は
文字コードはUTF-8で、
半角で255文字
ということになる。
この半角で255文字というのは全角文字は85字になる。
半角を1バイトとすると3バイトだからだ。
さらにサロゲートペアは4バイトである。
これを明らかにしたのが、
Excel for Microsoft 365 VBA Win32Apiとスピルを使いすべての文字のUTF-16 UTF-8 SJisの文字コードを取得する
こちらのSheetMake2から作成されるシートになる。
このWin32APIの判定精度の範囲では文字列はUTF-8のバイナリに変換される。
これを利用して、バイトでカウントするというものである。
今回も前回と同様、Win32APIを使う。下のコードは前回のものに追加した形で記述している。

# 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
'標準モジュールに以下のDeclare ステートメントを追加
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-16LE SarrogatePairのコード
Sub TestSarrogatePair()
' For Excel
' ActiveCellにサロゲートペア文字が1字入っているとして、
' その上位サロゲートと下位サロゲートを求めて、試験のために
' MsgBoxExで表示する
' このため、Windows APIを使用する
' UTF-16 LE , BEなら bb(0) bb(1) bb(2) bb(3)になる
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) '?:文字リテラルでは誤解があるといけないので
    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
' test版であり、検証中です
' UTF-8に変換し、Byte配列に代入し、個数をカウントする
' 255より大きい場合はFalse
' この関数を使う場合、
' https://qiita.com/Q11Q/items/a2d61545d9e5c4e15f22
' 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

前回のモジュールに追加する。
今回追加したのは
LenByteUTF8

Function LengthUTF8(s As String)
' test版であり、検証中です
' UTF-8に変換し、Byte配列に代入し、個数をカウントする
' 255より大きい場合はFalse
' この関数を使う場合、
' https://qiita.com/Q11Q/items/a2d61545d9e5c4e15f22
' 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

とIsLengthle255byteOnUTF8
である。

Function IsLengthle255byteOnUTF8(s As String) As Boolean
' test版であり、検証中です
' UTF-8に変換し、Byte配列に代入し、個数をカウントする
' 255より大きい場合はFalse
' この関数を使う場合、
' https://qiita.com/Q11Q/items/a2d61545d9e5c4e15f22
' 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

前回のtoUTF8からbyte単位のカウント方法が判る。

ReDim Ret(0 To nBufferSize - 1)
ここでバイト単位がカウントされている。
このまま出してもいいのかもしれないが、Win32APIの挙動がわからないので、確実に配列に代入する。
そしてUboundで取得した要素数に1を足す。
これも0ではなく Redimのときに1にしてよいのかもしれないが、この配列がWin32Apiに入るため、変えないほうがよいと判断した。

これはWindowsのサーバーのディレクトリやファイルの長さではありません

社長のブログにあるようにUTF-8で半角で255字、255バイトと言われるのはWindowsではなくLinuxであり、Windowsのサーバーのファイルの長さはこれでは測ることができない。

サロゲートペアは4バイト

このベースでカウントするとサロゲートペアは4バイト、半角で4文字消費する。
全角のように見えても、42文字が限界になると考えられる。
検索してみると5バイトや6バイトがあるとかあるけどはねられるとか諸説が見つかる。
IBMの資料を見てもUTF-8は最大で4バイトとしている。
https://www.ibm.com/support/knowledgecenter/ja/SSEPGG_11.5.0/com.ibm.db2.luw.admin.nls.doc/doc/c0004816.html
このため、最大が4バイトとしておく。そして4バイトの例がサロゲートペアということになる。

バイトと文字数

今回の関数は文字列をUTF-8のバイト単位に換算している。それで全角も半角も関係なくコードに置き換えてその長さできまるようだ。
つまり容量としては255バイト、字数としては255字なので文中は使い分けている。

Win32APIと長所

たしかにコード的には長くなるがADODBを参照設定しなくていい。
また、toUTF8はUTF-8のバイト配列に変換してしまうため、スピルなどがなければ使いどころがなかった。
しかし、それはExcelのWorksheet上でしか有効ではないため、Excelでしか使いづらい。
今回の関数は字数をバイト数に変えたり、255文字を判定するため、Excelだけではなく、Access,Word,PublisehrOutlookでも活用が可能である。