VB.NETでも独自のエンコーディングを実装したい（後編）

VB.NET 文字コード

はじめい

前回こんな事をしました。

jyuch.hatenablog.com

今回は以下の感じでいい感じにアレをアレします。

  • フォールバックは例外フォールバックのみ
  • 必要最小限しか実装しない

実装

実装の流れは前の記事でも書いた通り

  1. Encoderの実装
  2. Decoderの実装
  3. Encodingの実装
  4. 試しにエンコード・デコードをする
  5. 楽しい✌('ω'✌ )三✌('ω')✌三( ✌'ω')✌

の流れとなっております。

Public Class JyuchKanaEncoder
    Inherits Encoder

    ' 全部例外フォールバックで対応

    Public Sub New(encoding As Encoding)
        Me.Fallback = encoding.EncoderFallback
    End Sub

    Public Overrides Function GetByteCount(chars() As Char, index As Integer, count As Integer, flush As Boolean) As Integer
        Dim result = 0
        For Each it In chars.Skip(index).Take(count)
            If IsDiscernibleChar(it) Then
                result += 1
            Else
                Throw New EncoderFallbackException()
            End If
        Next
        Return result
    End Function

    Public Overrides Function GetBytes(chars() As Char, charIndex As Integer, charCount As Integer, bytes() As Byte, byteIndex As Integer, flush As Boolean) As Integer
        Dim ci = byteIndex
        Dim consumed = 0

        For Each c In chars.Skip(charIndex).Take(charCount)
            Try
                Dim b = ConvertToByte(c)
                bytes(ci) = b
                ci += 1
                consumed += 1
            Catch ex As ArgumentException
                Throw New EncoderFallbackException()
            End Try
        Next
        Return consumed
    End Function

    Private Function IsDiscernibleChar(c As Char) As Boolean
        Dim point As Integer = Microsoft.VisualBasic.Strings.AscW(c)

        Select Case point
            Case &H0 ' NUL
                Return True
            Case &HA ' LF
                Return True
            Case &HD ' CR
                Return True
            Case &H20 ' SPACE
                Return True
            Case &H41 To &H7A ' LATIN ALPHABET
                Return True
            Case &H3000 ' IDSP
                Return True
            Case &H3041 To &H3093 ' HIRAGANA
                Return True
            Case Else ' OTHER
                Return False
        End Select
    End Function

    Private Function ConvertToByte(c As Char) As Byte
        Dim point As Integer = Microsoft.VisualBasic.Strings.AscW(c)

        Select Case point
            Case &H0 ' NUL
                Return &H0
            Case &HA ' LF
                Return &H1
            Case &HD ' CR
                Return &H2
            Case &H20 ' SPACE
                Return &H10
            Case &H41 To &H7A ' LATIN ALPHABET
                Return CByte(point - &H30)
            Case &H3000 ' IDSP
                Return &H50
            Case &H3041 To &H3093 ' HIRAGANA
                Return CByte(point - &H2FF0)
            Case Else ' OTHER
                Throw New ArgumentException()
        End Select
    End Function
End Class

Public Class JyuchKanaDecoder
    Inherits Decoder

    ' 全部例外フォールバックで対応

    Public Sub New(encoding As Encoding)
        Me.Fallback = encoding.DecoderFallback
    End Sub

    Public Overloads Overrides Function GetCharCount(bytes() As Byte, index As Integer, count As Integer) As Integer
        Dim result = 0
        For Each b In bytes.Skip(index).Take(count)
            If IsDiscernibleByte(b) Then
                result += 1
            Else
                Throw New DecoderFallbackException()
            End If
        Next
        Return result
    End Function

    Public Overloads Overrides Function GetChars(bytes() As Byte, byteIndex As Integer, byteCount As Integer, chars() As Char, charIndex As Integer) As Integer
        Dim ci = charIndex
        Dim consumed = 0

        For Each b In bytes.Skip(byteIndex).Take(byteCount)
            Try
                Dim c = ConvertToChar(b)
                chars(ci) = c
                ci += 1
                consumed += 1
            Catch ex As Exception
                Throw New DecoderFallbackException()
            End Try
        Next
        Return consumed
    End Function

    Private Function IsDiscernibleByte(b As Byte) As Boolean
        Select Case b
            Case &H0 ' NUL
                Return True
            Case &H1 ' LF
                Return True
            Case &H2 ' CR
                Return True
            Case &H10 ' SPACE
                Return True
            Case &H11 To &H44 ' LATIN ALPHABET
                Return True
            Case &H50 ' IDSP
                Return True
            Case &H51 To &HA3 ' HIRAGANA
                Return True
            Case Else ' OTHER
                Return False
        End Select
    End Function

    Private Function ConvertToChar(b As Byte) As Char
        Select Case b
            Case &H0 ' NUL
                Return Microsoft.VisualBasic.Strings.ChrW(&H0)
            Case &H1 ' LF
                Return Microsoft.VisualBasic.Strings.ChrW(&HA)
            Case &H2 ' CR
                Return Microsoft.VisualBasic.Strings.ChrW(&HD)
            Case &H10 ' SPACE
                Return Microsoft.VisualBasic.Strings.ChrW(&H20)
            Case &H11 To &H44 ' LATIN ALPHABET
                Return Microsoft.VisualBasic.Strings.ChrW(b + &H30)
            Case &H50 ' IDSP
                Return Microsoft.VisualBasic.Strings.ChrW(&H3000)
            Case &H51 To &HA3 ' HIRAGANA
                Return Microsoft.VisualBasic.Strings.ChrW(b + &H2FF0)
            Case Else ' OTHER
                Throw New ArgumentException()
        End Select
    End Function
End Class

Public Class JyuchKanaEncoding
    Inherits Encoding


    Public Sub New()
    End Sub

    Public Overloads Overrides Function GetByteCount(chars() As Char, index As Integer, count As Integer) As Integer
        Dim e = New JyuchKanaEncoder(Me)
        Return e.GetByteCount(chars, index, count, True)
    End Function

    Public Overloads Overrides Function GetBytes(chars() As Char, charIndex As Integer, charCount As Integer, bytes() As Byte, byteIndex As Integer) As Integer
        Dim e = New JyuchKanaEncoder(Me)
        Return e.GetBytes(chars, charIndex, charCount, bytes, byteIndex, True)
    End Function

    Public Overrides Function GetBytes(s As String) As Byte()
        Return MyBase.GetBytes(s)
    End Function

    Public Overloads Overrides Function GetCharCount(bytes() As Byte, index As Integer, count As Integer) As Integer
        Dim d = New JyuchKanaDecoder(Me)
        Return d.GetCharCount(bytes, index, count)
    End Function

    Public Overloads Overrides Function GetChars(bytes() As Byte, byteIndex As Integer, byteCount As Integer, chars() As Char, charIndex As Integer) As Integer
        Dim d = New JyuchKanaDecoder(Me)
        Return d.GetChars(bytes, byteIndex, byteCount, chars, charIndex)
    End Function

    Public Overrides Function GetString(bytes() As Byte) As String
        Return MyBase.GetString(bytes)
    End Function

    Public Overrides Function GetMaxByteCount(charCount As Integer) As Integer
        ' 指定した文字数をエンコしたときに生成される最大のバイト数
        ' フォールバックされたときはバッファが返す文字数が分からないので
        ' フォールバック時は考慮しなくてok?
        Return charCount
    End Function

    Public Overrides Function GetMaxCharCount(byteCount As Integer) As Integer
        ' 指定したバイト数をデコードしたときに生成される最大文字数
        ' こっちもフォールバック時は気にしなくてok?
        Return byteCount
    End Function

    Public Overrides Function GetEncoder() As Encoder
        Return New JyuchKanaEncoder(Me)
    End Function

    Public Overrides Function GetDecoder() As Decoder
        Return New JyuchKanaDecoder(Me)
    End Function
End Class

とくにひねりもなく適当に足し算引き算しながら一対一で対応付けてるだけです。 なんかPythonのコードをそのままVBに移植したコードってかそのまんまです。

GetMaxByteCountとGetMaxCharCountは最適フォールバックや置換フォールバックされた時はどんな文字が返されるときは予測ができないのでとりあえず正常に変換できた時のバイト数や文字数を返しています。これでいいんかな？

一応標準ライブラリなんかも参考にしたけどポインタの嵐でポインタがダメでC#に逃げてきた弊社にはすこし辛いものがありました。 あと、たった今CLIの規格票を読んでて知ったんだけどCLSに準拠してないメソッドは拡張側は実装しなくていいっぽい?*1

それで利用側はこんな感じ。

Imports こころぴょんぴょん = System.Console

Module Main

    Sub Main()
        Dim encoding = New JyuchKanaEncoding()

        ' Hello<SP>World<SP>こんにちは<IDSP>せかい
        Dim target = "Hello World こんにちは　せかい"
        Dim dist = encoding.GetBytes(target)
        Dim decode = encoding.GetString(dist)

        こころぴょんぴょん.WriteLine(target)

        For Each b In dist
            こころぴょんぴょん.Write("{0:X2} ", b)
        Next
        こころぴょんぴょん.WriteLine()

        こころぴょんぴょん.WriteLine(decode)
    End Sub

End Module

散々煮え湯を飲まされているVBなのでせめてコンソールに文字を出力するときくらいはこころぴょんぴょんできるようにしてみました。

んで、一応出力結果がこれ。

Hello World こんにちは　せかい
18 35 3C 3C 3F 10 27 3F 42 3C 34 10 63 A3 7B 71 7F 50 6B 5B 54
Hello World こんにちは　せかい

多分うまく動いている。

まとめ

なんか突貫な上に解説っぽい解説もないので申し訳ないのですが、正直こんな感じていいのか弊社もわからないのでこんな感じなら一応できたってことで載せています。

あと、今更なんですが、コード中のArgumentExceptionはArgumentOutOfRangeExceptionの方が良かったんじゃないかと思いました。

おわり

*1:正確には実装を強要しちゃダメっぽい