NonSoft

文字コード判定のサンプル(VB.NET)


 サンプル(ソース/コード)
<このサンプルの概要>
このサンプルは以下のアルゴリズムで文字コード判定をしています。文字コードの性質上、
100%完璧な文字コード判定は難しいですが出来るだけ精度の高い判定を目指しています。

1.JIS(ISO-2022-JP)の文字コード判定
  以下の制御コード列が存在したらJIS(ISO-2022-JP)と判定とする。
  ・&H1B, &H28, &H42 (ASCII)
  ・&H1B, &H28, &H4A (JISローマ字)
  ・&H1B, &H28, &H49 (JISカナ字)
  ・&H1B, &H24, &H40 (旧JIS漢字)
  ・&H1B, &H24, &H42 (新JIS漢字)
  ・&H1B, &H24, &H44 (JIS補助漢字)

  存在しなければ他の文字コードと判定する。

2.UNICODEの文字コード判定
  以下の制御コード列が存在したらUNICODEと判定とする。
  ・&HFF, &HFE (BOM:UNICODEを示すコード)

  存在しなければUNICODEの可能性を確率として計算する。
  ・2バイト目が&H00の時は2点加算(1バイト目は判定しない)
  ・2バイト目が&H01〜&H33の時は2点加算(1バイト目は判定しない)
  ・2バイト目が&H34〜&H4Dの時は0点として判定終了
  ・2バイト目が&H4E〜&H9Fの時は2点加算(1バイト目は判定しない)
  ・2バイト目が&HA0〜&HABの時は0点として判定終了
  ・2バイト目が&HAC〜&HD7の時は0点として判定終了
  ・2バイト目が&HD8〜&DFの時は2点加算(1バイト目は判定しない)
  ・2バイト目が&HE0〜&F7の時は0点として判定終了
  ・2バイト目が&HF8〜&FFの時は2点加算(1バイト目は判定しない)

  計算結果の点数をチェックしたバイト数の2倍で割り確率%を計算する。
  全てが複数バイトコードなので100%になる。
  UNICODEでは無いと判定した時は0%になる。

3.UTF-8の文字コード判定
  以下の制御コード列が存在したらUTF-8と判定とする。
  ・&HEF, &HBB, &HBF (BOM:UTF-8を示すコード)

  存在しなければUTF-8の可能性を確率として計算する。
  ・1バイト目に&HFCのビットが立っていて2〜6バイト目が&H80〜&HBFの時は
   バイト数(この場合は6バイト)の2倍の点数を加算
  ・1バイト目に&HF8のビットが立っていて2〜5バイト目が&H80〜&HBFの時は
   バイト数(この場合は5バイト)の2倍の点数を加算
  ・1バイト目に&HF0のビットが立っていて2〜4バイト目が&H80〜&HBFの時は
   バイト数(この場合は4バイト)の4倍の点数を加算
  ・1バイト目に&HE0のビットが立っていて2〜3バイト目が&H80〜&HBFの時は
   バイト数(この場合は3バイト)の2倍の点数を加算
  ・1バイト目に&HC0のビットが立っていて2バイト目が&H80〜&HBFの時は
   バイト数(この場合は2バイト)の2倍の点数を加算
  ・1バイト目が&H00〜&H7Fの時は1点加算

  計算結果の点数をチェックしたバイト数の2倍で割り確率%を計算する。
  全てが複数バイトコードの場合は100%、全てが半角コードの場合は50%になる。
  (複数バイトコードが一致した時は確率が高くなる)

4.UTF-7の文字コード判定
  UTF-7の可能性を確率として計算する。
  ・'+'〜'-'の間にBASE64文字が存在する時は'+'〜'-'のバイト数の2倍の点数を加算
   (最後の文字の余分な付加ビットが0で無ければ無効)
   BASE64=(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
  ・1バイト目が&H00〜&H7Fの時は1点加算

  計算結果の点数をチェックしたバイト数の2倍で割り確率%を計算する。
  全てが複数バイトコードの場合は100%、全てが半角コードの場合は50%になる。
  (複数バイトコードが一致した時は確率が高くなる)

5.SJISの文字コード判定
  SJISの可能性を確率として計算する。
  ・1バイト目が&H81〜&H9F、&HE0〜&HEFで2バイト目が&H40〜&H7E、&H80〜&HFCの時はバイト数
   (この場合は2バイト)の2倍の点数を加算
  ・1バイト目が&HA1〜&HDFの時は1点加算
  ・1バイト目が&H00〜&H7Fの時は1点加算

  計算結果の点数をチェックしたバイト数の2倍で割り確率%を計算する。
  全てが複数バイトコードの場合は100%、全てが半角コードの場合は50%になる。
  (複数バイトコードが一致した時は確率が高くなる)

6.EUCの文字コード判定
  EUCの可能性を確率として計算する。
  ・1バイト目が&H8Eで2バイト目が&HA1〜&HDFの時は
   バイト数(この場合は2バイト)の2倍の点数を加算
  ・1バイト目が&H8Fで2、3バイト目が&HA1〜&HFEの時は
   バイト数(この場合は3バイト)の2倍の点数を加算
  ・1バイト目が&HA1〜&HFEで2バイト目が&HA1〜&HFEの時は
   バイト数(この場合は2バイト)の2倍の点数を加算
  ・1バイト目が&H00〜&H7Fの時は1点加算

  計算結果の点数をチェックしたバイト数の2倍で割り確率%を計算する。
  全てが複数バイトコードの場合は100%、全てが半角コードの場合は50%になる。
  (複数バイトコードが一致した時は確率が高くなる)

7.各文字コードの確率を比較し文字コードを判定する。

バージョンアップ版(文字コード判定精度向上、バイナリ判定追加)をライブラリ(DLL)
として公開していますのでお試しください。
文字コード判定/変換DLL(VB6/VB.NET/C#.NET)

VB6版のサンプルソースもあります。
文字コード判定のサンプル(VB6)

「ネット(Web)で手軽に文字コード判定サービス!!」をお試し頂けます。
文字コード判定ツール.NET

関連情報
文字コード判定のサンプル(VB6) ★最新版★
ADODB.Streamによる文字コード変換のサンプル(VB6/VB.NET)
WideCharToMultiByteとMultiByteToWideCharによる文字コード変換のサンプル(VB6/VB.NET)
文字コード判定/変換ツール(VB6のソース付)
文字コード判定&変換ツール.NET

★標準モジュール(Module1.vb)
Module Module1
    '****************************************************************************
    ' 機能名    : Module1.vb
    ' 機能説明  : 文字コード判定
    ' 備考      :
    ' 著作権    : Copyright(C) 2008 - 2009 のん All rights reserved
    '           : このプログラムは、日本国著作権法および国際条約により保護
    '           : されています。このプログラムを転載する場合は著作権所有者
    '           : の許可が必要となります。
    ' ---------------------------------------------------------------------------
    ' 使用条件  : このサイトの内容を使用(流用/改変/転載/等全て)した成果物を不特定
    '           : 多数に公開/配布する場合は、このサイトを参考にした旨を記述してく
    '           : ださい。(例)WEBページやReadMeにリンクを貼ってください
    ' ---------------------------------------------------------------------------
    '****************************************************************************
    Private Const JUDGEFIX = 9999       '文字コード決定%
    Private Const JUDGESIZEMAX = 1000   '文字コード判定バイト数
    Private Const SingleByteWeight = 1  '1バイト 文字コードの一致重み
    Private Const Multi_ByteWeight = 2  '複数バイト文字コードの一致重み
    Private Enum JISMODE                'JISコードのモード
        ctrl = 0                        '制御コード
        asci = 1                        'ASCII
        roma = 2                        'JISローマ字
        kana = 3                        'JISカナ(半角カナ)
        kanO = 4                        '旧JIS漢字 (1978)
        kanN = 5                        '新JIS漢字 (1983/1990)
        kanH = 6                        'JIS補助漢字
    End Enum

    '----文字コード判定
    ' 関数名    : JudgeCode
    ' 返り値    : 判定結果文字コード名
    ' 引き数    : bytCode : 判定文字データ
    ' 機能説明  : 文字コードを判定する
    ' 備考      :
    Public Function JudgeCode(ByRef bytCode() As Byte) As String
        JudgeCode = "SJIS"
        Dim lngSJIS As Long
        Dim lngJIS As Long
        Dim lngEUC As Long
        Dim lngUNI As Long
        Dim lngUTF7 As Long
        Dim lngUTF8 As Long

        lngJIS = JudgeJIS(bytCode, True) : System.Diagnostics.Trace.WriteLine("JIS :" & lngJIS)
        If lngJIS >= JUDGEFIX Then JudgeCode = "JIS" : Exit Function

        lngUNI = JudgeUNI(bytCode, True) : System.Diagnostics.Trace.WriteLine("UNI :" & lngUNI)
        If lngUNI >= JUDGEFIX Then JudgeCode = "UNICODE" : Exit Function

        lngUTF8 = JudgeUTF8(bytCode, True) : System.Diagnostics.Trace.WriteLine("UTF8:" & lngUTF8)
        If lngUTF8 >= JUDGEFIX Then JudgeCode = "UTF8" : Exit Function

        lngUTF7 = JudgeUTF7(bytCode, True) : System.Diagnostics.Trace.WriteLine("UTF7:" & lngUTF7)
        If lngUTF7 >= JUDGEFIX Then JudgeCode = "UTF7" : Exit Function

        lngSJIS = JudgeSJIS(bytCode, True) : System.Diagnostics.Trace.WriteLine("SJIS:" & lngSJIS)
        If lngSJIS >= JUDGEFIX Then JudgeCode = "SJIS" : Exit Function

        lngEUC = JudgeEUC(bytCode, True) : System.Diagnostics.Trace.WriteLine("EUC :" & lngEUC)
        If lngEUC >= JUDGEFIX Then JudgeCode = "EUC" : Exit Function
        System.Diagnostics.Trace.WriteLine("--------")

        If lngSJIS >= lngSJIS And lngSJIS >= lngUNI And lngSJIS >= lngJIS And _
           lngSJIS >= lngUTF7 And lngSJIS >= lngUTF8 And lngSJIS >= lngEUC Then
            JudgeCode = "SJIS"
            Exit Function
        End If

        If lngUNI >= lngSJIS And lngUNI >= lngUNI And lngUNI >= lngJIS And _
           lngUNI >= lngUTF7 And lngUNI >= lngUTF8 And lngUNI >= lngEUC Then
            JudgeCode = "UNICODE"
            Exit Function
        End If

        If lngJIS >= lngSJIS And lngJIS >= lngUNI And lngJIS >= lngJIS And _
           lngJIS >= lngUTF7 And lngJIS >= lngUTF8 And lngJIS >= lngEUC Then
            JudgeCode = "JIS"
            Exit Function
        End If

        If lngUTF7 >= lngSJIS And lngUTF7 >= lngUNI And lngUTF7 >= lngJIS And _
           lngUTF7 >= lngUTF7 And lngUTF7 >= lngUTF8 And lngUTF7 >= lngEUC Then
            JudgeCode = "UTF7"
            Exit Function
        End If

        If lngUTF8 >= lngSJIS And lngUTF8 >= lngUNI And lngUTF8 >= lngJIS And _
           lngUTF8 >= lngUTF7 And lngUTF8 >= lngUTF8 And lngUTF8 >= lngEUC Then
            JudgeCode = "UTF8"
            Exit Function
        End If

        If lngEUC >= lngSJIS And lngEUC >= lngUNI And lngEUC >= lngJIS And _
           lngEUC >= lngUTF7 And lngEUC >= lngUTF8 And lngEUC >= lngEUC Then
            JudgeCode = "EUC"
            Exit Function
        End If

    End Function

    '----SJIS関係
    ' 関数名    : JudgeSJIS
    ' 返り値    : 判定結果確率(%)
    ' 引き数    : bytCode : 判定文字データ
    '           : fixFlag : 確定判断有無
    ' 機能説明  : SJISの文字コード判定(可能性)確率を計算する
    ' 備考      :
    Private Function JudgeSJIS(ByRef bytCode() As Byte, _
    Optional ByVal fixFlag As Boolean = False) As Integer
        Dim i As Long
        Dim lngFit As Long
        Dim lngUB As Long

        lngUB = JUDGESIZEMAX - 1
        If lngUB > UBound(bytCode) Then
            lngUB = UBound(bytCode)
        End If
        For i = 0 To lngUB
            '81-9F,E0-EF(1バイト目)
            If (bytCode(i) >= &H81 And bytCode(i) <= &H9F) Or _
               (bytCode(i) >= &HE0 And bytCode(i) <= &HEF) Then
                If i <= UBound(bytCode) - 1 Then
                    '40-7E,80-FC(2バイト目)
                    If (bytCode(i + 1) >= &H40 And bytCode(i + 1) <= &H7E) Or _
                       (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HFC) Then
                        lngFit = lngFit + (2 * Multi_ByteWeight)
                        i = i + 1
                    End If
                End If

                'A1-DF(1バイト目)
            ElseIf (bytCode(i) >= &HA1 And bytCode(i) <= &HDF) Then
                lngFit = lngFit + (1 * SingleByteWeight)

                '20-7E(1バイト目)
            ElseIf (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
                lngFit = lngFit + (1 * SingleByteWeight)

                '00-1F, 7F(1バイト目)
            ElseIf (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
                    bytCode(i) = &H7F Then
                lngFit = lngFit + (1 * SingleByteWeight)
            End If
        Next i
        JudgeSJIS = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
    End Function

    '----JIS関係
    ' 関数名    : JudgeJIS
    ' 返り値    : 判定結果確率(%)
    ' 引き数    : bytCode : 判定文字データ
    '           : fixFlag : 確定判断有無
    ' 機能説明  : JISの文字コード判定(可能性)確率を計算する
    ' 備考      :
    Private Function JudgeJIS(ByRef bytCode() As Byte, _
    Optional ByVal fixFlag As Boolean = False) As Integer
        Dim i As Long
        Dim lngFit As Long
        Dim lngMode As JISMODE
        Dim lngUB As Long

        lngUB = JUDGESIZEMAX - 1
        If lngUB > UBound(bytCode) Then
            lngUB = UBound(bytCode)
        End If
        For i = 0 To lngUB
            '1B(1バイト目)
            If bytCode(i) = &H1B Then
                If i <= UBound(bytCode) - 2 Then
                    '28 42(2・3バイト目)
                    If bytCode(i + 1) = &H28 And bytCode(i + 1) <= &H42 Then
                        lngMode = JISMODE.asci
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                        If fixFlag Then
                            JudgeJIS = JUDGEFIX
                            Exit Function
                        End If
                    End If
                    '28 4A(2・3バイト目)
                    If bytCode(i + 1) = &H28 And bytCode(i + 1) <= &H4A Then
                        lngMode = JISMODE.roma
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                        If fixFlag Then
                            JudgeJIS = JUDGEFIX
                            Exit Function
                        End If
                    End If
                    '28 49(2・3バイト目)
                    If bytCode(i + 1) = &H28 And bytCode(i + 1) <= &H49 Then
                        lngMode = JISMODE.kana
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                        If fixFlag Then
                            JudgeJIS = JUDGEFIX
                            Exit Function
                        End If
                    End If
                    '24 40(2・3バイト目)
                    If bytCode(i + 1) = &H24 And bytCode(i + 1) <= &H40 Then
                        lngMode = JISMODE.kanO
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                        If fixFlag Then
                            JudgeJIS = JUDGEFIX
                            Exit Function
                        End If
                    End If
                    '24 42(2・3バイト目)
                    If bytCode(i + 1) = &H24 And bytCode(i + 1) <= &H42 Then
                        lngMode = JISMODE.kanN
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                        If fixFlag Then
                            JudgeJIS = JUDGEFIX
                            Exit Function
                        End If
                    End If
                    '24 44(2・3バイト目)
                    If bytCode(i + 1) = &H24 And bytCode(i + 1) <= &H44 Then
                        lngMode = JISMODE.kanH
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                        If fixFlag Then
                            JudgeJIS = JUDGEFIX
                            Exit Function
                        End If
                    End If
                End If
            Else
                Select Case lngMode
                    Case JISMODE.ctrl, JISMODE.asci, JISMODE.roma
                        '00-1F,7F
                        If (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
                            bytCode(i) = &H7F Then
                            lngFit = lngFit + (1 * SingleByteWeight)
                        End If
                        '20-7E
                        If (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
                            lngFit = lngFit + (1 * SingleByteWeight)
                        End If
                    Case JISMODE.kana
                        '21-5F
                        If (bytCode(i) >= &H21 And bytCode(i) <= &H5F) Then
                            lngFit = lngFit + (1 * SingleByteWeight)
                        End If
                    Case JISMODE.kanO, JISMODE.kanN, JISMODE.kanH
                        If i <= UBound(bytCode) - 1 Then
                            '21-7E
                            If (bytCode(i) >= &H21 And bytCode(i) <= &H7E) And _
                               (bytCode(i - 1) >= &H21 And bytCode(i - 1) <= &H7E) Then
                                lngFit = lngFit + (2 * Multi_ByteWeight)
                                i = i + 1
                            End If
                        End If
                End Select
            End If
        Next i
        JudgeJIS = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
    End Function

    '----EUC関係
    ' 関数名    : JudgeEUC
    ' 返り値    : 判定結果確率(%)
    ' 引き数    : bytCode : 判定文字データ
    '           : fixFlag : 確定判断有無
    ' 機能説明  : EUCの文字コード判定(可能性)確率を計算する
    ' 備考      :
    Private Function JudgeEUC(ByRef bytCode() As Byte, _
    Optional ByVal fixFlag As Boolean = False) As Integer
        Dim i As Long
        Dim lngFit As Long
        Dim lngUB As Long

        lngUB = JUDGESIZEMAX - 1
        If lngUB > UBound(bytCode) Then
            lngUB = UBound(bytCode)
        End If
        For i = 0 To lngUB
            '8E(1バイト目) + A1-DF(2バイト目)
            If bytCode(i) = &H8E Then
                If i <= UBound(bytCode) - 1 Then
                    If bytCode(i + 1) >= &HA1 And bytCode(i + 1) <= &HDF Then
                        lngFit = lngFit + (2 * Multi_ByteWeight)
                        i = i + 1
                    End If
                End If

                '8F(1バイト目) + A1-0xFE(2・3バイト目)
            ElseIf bytCode(i) = &H8F Then
                If i <= UBound(bytCode) - 2 Then
                    If (bytCode(i + 1) >= &HA1 And bytCode(i + 1) <= &HFE) And _
                       (bytCode(i + 2) >= &HA1 And bytCode(i + 2) <= &HFE) Then
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                    End If
                End If

                'A1-FE(1バイト目) + A1-FE(2バイト目)
            ElseIf bytCode(i) >= &HA1 And bytCode(i) <= &HFE Then
                If i <= UBound(bytCode) - 1 Then
                    If bytCode(i + 1) >= &HA1 And bytCode(i + 1) <= &HFE Then
                        lngFit = lngFit + (2 * Multi_ByteWeight)
                        i = i + 1
                    End If
                End If

                '20-7E(1バイト目)
            ElseIf (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
                lngFit = lngFit + (1 * SingleByteWeight)

                '00-1F, 7F(1バイト目)
            ElseIf (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
                    bytCode(i) = &H7F Then
                lngFit = lngFit + (1 * SingleByteWeight)
            End If
        Next i
        JudgeEUC = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
    End Function

    '----UNICODE関係
    ' 関数名    : JudgeUNI
    ' 返り値    : 判定結果確率(%)
    ' 引き数    : bytCode : 判定文字データ
    '           : fixFlag : 確定判断有無
    ' 機能説明  : UTF16の文字コード判定(可能性)確率を計算する
    ' 備考      :
    Private Function JudgeUNI(ByRef bytCode() As Byte, _
    Optional ByVal fixFlag As Boolean = False) As Integer
        Dim i As Long
        Dim lngFit As Long
        Dim lngUB As Long

        lngUB = JUDGESIZEMAX - 1
        If lngUB > UBound(bytCode) Then
            lngUB = UBound(bytCode)
        End If
        For i = 0 To lngUB
            If fixFlag Then
                'BOM
                If bytCode(i) = &HFF Then
                    If i <= UBound(bytCode) - 1 Then
                        If bytCode(i + 1) = &HFE Then
                            JudgeUNI = JUDGEFIX
                            Exit Function
                        End If
                    End If
                End If
                '半角の証
                'If bytCode(i) = &H0 Then
                '    JudgeUNI = JUDGEFIX
                '    Exit Function
                'End If
            End If

            If i <= UBound(bytCode) - 1 Then
                '00(2バイト目)
                If (bytCode(i + 1) = &H0) Then
                    '00-FF(1バイト目)
                    lngFit = lngFit + (2 * Multi_ByteWeight)

                    '01-33(2バイト目)
                ElseIf (bytCode(i + 1) >= &H1 And bytCode(i + 1) <= &H33) Then
                    '00-FF(1バイト目)
                    lngFit = lngFit + (2 * Multi_ByteWeight)

                    '34-4D(2バイト目)
                ElseIf (bytCode(i + 1) >= &H34 And bytCode(i + 1) <= &H4D) Then
                    '00-FF(1バイト目)----空き----
                    lngFit = 0
                    Exit For

                    '4E-9F(2バイト目)
                ElseIf (bytCode(i + 1) >= &H4E And bytCode(i + 1) <= &H9F) Then
                    '00-FF(1バイト目)
                    lngFit = lngFit + (2 * Multi_ByteWeight)

                    'A0-AB(2バイト目)
                ElseIf (bytCode(i + 1) >= &HA0 And bytCode(i + 1) <= &HAB) Then
                    '00-FF(1バイト目)----空き----
                    lngFit = 0
                    Exit For

                    'AC-D7(2バイト目)
                ElseIf (bytCode(i + 1) >= &HAC And bytCode(i + 1) <= &HD7) Then
                    '00-FF(1バイト目)----ハングル----
                    lngFit = 0
                    Exit For

                    'D8-DF(2バイト目)
                ElseIf (bytCode(i + 1) >= &HD8 And bytCode(i + 1) <= &HDF) Then
                    '00-FF(1バイト目)
                    lngFit = lngFit + (2 * Multi_ByteWeight)

                    'E0-F7(2バイト目)
                ElseIf (bytCode(i + 1) >= &HE0 And bytCode(i + 1) <= &HF7) Then
                    '00-FF(1バイト目)----外字----
                    lngFit = 0
                    Exit For

                    'F8-FF(2バイト目)
                ElseIf (bytCode(i + 1) >= &HF8 And bytCode(i + 1) <= &HFF) Then
                    '00-FF(1バイト目)
                    lngFit = lngFit + (2 * Multi_ByteWeight)

                End If
                i = i + 1
            End If
        Next i
        JudgeUNI = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
    End Function

    '----UTF7関係
    ' 関数名    : JudgeUTF7
    ' 返り値    : 判定結果確率(%)
    ' 引き数    : bytCode : 判定文字データ
    '           : fixFlag : 確定判断有無
    ' 機能説明  : UTF7の文字コード判定(可能性)確率を計算する
    ' 備考      :
    Private Function JudgeUTF7(ByRef bytCode() As Byte, _
    Optional ByVal fixFlag As Boolean = False) As Integer
        Dim i As Long
        Dim lngFit As Long
        Dim lngWrk As Long
        Dim str64 As String
        Dim bln64 As Boolean
        str64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
        Dim lngUB As Long
        Dim lngBY As Long
        Dim lngXB As Long
        Dim lngXX As Long

        lngUB = JUDGESIZEMAX - 1
        If lngUB > UBound(bytCode) Then
            lngUB = UBound(bytCode)
        End If
        lngWrk = 0

        For i = 0 To lngUB
            '+〜-まではBASE64ENCODE
            If bytCode(i) = Asc("+") And bln64 = False Then
                lngWrk = 1
                bln64 = True
            ElseIf bytCode(i) = Asc("-") Then
                If lngWrk <= 0 Then
                    lngWrk = lngWrk + 1
                    lngFit = lngFit + (lngWrk * SingleByteWeight)
                ElseIf lngWrk = 1 Then
                    lngWrk = lngWrk + 1
                    lngFit = lngFit + (lngWrk * Multi_ByteWeight)
                ElseIf lngWrk >= 4 And lngXB < 6 And _
                       ((InStr(str64, Chr(bytCode(i - 1))) - 1) And lngXX) = 0 Then
                    lngWrk = lngWrk + 1
                    lngFit = lngFit + (lngWrk * Multi_ByteWeight)
                End If
                lngWrk = 0
                bln64 = False
            Else
                If bln64 = True Then
                    'BASE64ENCODE中
                    If InStr(str64, Chr(bytCode(i))) > 0 Then
                        lngBY = Int((lngWrk * 6) / 8)
                        lngXB = (lngWrk * 6) - (lngBY * 8)
                        lngXX = (2 ^ lngXB) - 1
                        lngWrk = lngWrk + 1
                    Else
                        lngWrk = 0
                        bln64 = False
                    End If
                Else
                    '20-7E(1バイト目)
                    If (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
                        lngFit = lngFit + (1 * SingleByteWeight)

                        '00-1F, 7F(1バイト目)
                    ElseIf (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
                            bytCode(i) = &H7F Then
                        lngFit = lngFit + (1 * SingleByteWeight)
                    End If
                End If
            End If
        Next i
        JudgeUTF7 = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
    End Function

    '----UTF8関係
    ' 関数名    : JudgeUTF8
    ' 返り値    : 判定結果確率(%)
    ' 引き数    : bytCode : 判定文字データ
    '           : fixFlag : 確定判断有無
    ' 機能説明  : UTF8の文字コード判定(可能性)確率を計算する
    ' 備考      :
    Private Function JudgeUTF8(ByRef bytCode() As Byte, _
    Optional ByVal fixFlag As Boolean = False) As Integer
        Dim i As Long
        Dim lngFit As Long
        Dim lngUB As Long

        lngUB = JUDGESIZEMAX - 1
        If lngUB > UBound(bytCode) Then
            lngUB = UBound(bytCode)
        End If
        For i = 0 To lngUB
            If fixFlag Then
                'BOM
                If bytCode(i) = &HEF Then
                    If i <= UBound(bytCode) - 2 Then
                        If bytCode(i + 1) = &HBB And _
                           bytCode(i + 2) = &HBF Then
                            JudgeUTF8 = JUDGEFIX
                            Exit Function
                        End If
                    End If
                End If
            End If

            'AND FC(1バイト目) + 80-BF(2-6バイト目)
            If (bytCode(i) And &HFC) = &HFC Then
                If i <= UBound(bytCode) - 5 Then
                    If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
                       (bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) And _
                       (bytCode(i + 3) >= &H80 And bytCode(i + 3) <= &HBF) And _
                       (bytCode(i + 4) >= &H80 And bytCode(i + 4) <= &HBF) And _
                       (bytCode(i + 5) >= &H80 And bytCode(i + 5) <= &HBF) Then
                        lngFit = lngFit + (6 * Multi_ByteWeight)
                        i = i + 5
                    End If
                End If

                'AND F8(1バイト目) + 80-BF(2-5バイト目)
            ElseIf (bytCode(i) And &HF8) = &HF8 Then
                If i <= UBound(bytCode) - 4 Then
                    If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
                       (bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) And _
                       (bytCode(i + 3) >= &H80 And bytCode(i + 3) <= &HBF) And _
                       (bytCode(i + 4) >= &H80 And bytCode(i + 4) <= &HBF) Then
                        lngFit = lngFit + (5 * Multi_ByteWeight)
                        i = i + 4
                    End If
                End If

                'AND F0(1バイト目) + 80-BF(2-4バイト目)
            ElseIf (bytCode(i) And &HF0) = &HF0 Then
                If i <= UBound(bytCode) - 3 Then
                    If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
                       (bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) And _
                       (bytCode(i + 3) >= &H80 And bytCode(i + 3) <= &HBF) Then
                        lngFit = lngFit + (4 * Multi_ByteWeight)
                        i = i + 3
                    End If
                End If

                'AND E0(1バイト目) + 80-BF(2-3バイト目)
            ElseIf (bytCode(i) And &HE0) = &HE0 Then
                If i <= UBound(bytCode) - 2 Then
                    If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) And _
                       (bytCode(i + 2) >= &H80 And bytCode(i + 2) <= &HBF) Then
                        lngFit = lngFit + (3 * Multi_ByteWeight)
                        i = i + 2
                    End If
                End If

                'AND C0(1バイト目) + 80-BF(2バイト目)
            ElseIf (bytCode(i) And &HC0) = &HC0 Then
                If i <= UBound(bytCode) - 1 Then
                    If (bytCode(i + 1) >= &H80 And bytCode(i + 1) <= &HBF) Then
                        lngFit = lngFit + (2 * Multi_ByteWeight)
                        i = i + 1
                    End If
                End If

                '20-7E(1バイト目)
            ElseIf (bytCode(i) >= &H20 And bytCode(i) <= &H7E) Then
                lngFit = lngFit + (1 * SingleByteWeight)

                '00-1F, 7F(1バイト目)
            ElseIf (bytCode(i) >= &H0 And bytCode(i) <= &H1F) Or _
                    bytCode(i) = &H7F Then
                lngFit = lngFit + (1 * SingleByteWeight)
            End If
        Next i
        JudgeUTF8 = (lngFit * 100) / ((lngUB + 1) * Multi_ByteWeight)
    End Function
End Module

★フォームモジュール(Form1.vb)
    Private cod() As Byte
    Private Sub Form1_Load( _
        ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles MyBase.Load
        ReDim cod(0)
    End Sub
    Private Sub Button1_Click( _
        ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles Button1.Click
        Dim dlg As New OpenFileDialog
        dlg.Filter = "すべてのファイル (*.*)|*.*"
        If dlg.ShowDialog() = DialogResult.OK Then
            Dim sr As System.IO.Stream = dlg.OpenFile()
            Dim br As New System.IO.BinaryReader(sr)
            ReDim cod(sr.Length - 1)
            cod = br.ReadBytes(sr.Length)
            br.Close()
            sr.Close()
            ComboBox1.Text = JudgeCode(cod)
            If ComboBox1.Text = "SJIS" Then
                ' 文字コード判定結果(SJIS)
                TextBox1.Text = System.Text.Encoding.GetEncoding("SHIFT-JIS").GetString(cod)
            ElseIf ComboBox1.Text = "JIS" Then
                ' 文字コード判定結果(JIS)
                TextBox1.Text = System.Text.Encoding.GetEncoding("ISO-2022-JP").GetString(cod)
            ElseIf ComboBox1.Text = "EUC" Then
                ' 文字コード判定結果(EUC)
                TextBox1.Text = System.Text.Encoding.GetEncoding("EUC-JP").GetString(cod)
            ElseIf ComboBox1.Text = "UNICODE" Then
                ' 文字コード判定結果(UNICODE)
                TextBox1.Text = System.Text.Encoding.GetEncoding("UNICODE").GetString(cod)
            ElseIf ComboBox1.Text = "UTF7" Then
                ' 文字コード判定結果(UTF7)
                TextBox1.Text = System.Text.Encoding.GetEncoding("UTF-7").GetString(cod)
            ElseIf ComboBox1.Text = "UTF8" Then
                ' 文字コード判定結果(UTF8)
                TextBox1.Text = System.Text.Encoding.GetEncoding("UTF-8").GetString(cod)
            End If
        End If
    End Sub

    Private Sub ComboBox1_SelectedIndexChanged( _
        ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles ComboBox1.SelectedIndexChanged
        If UBound(cod) <= 0 Then
            Exit Sub
        End If
        If ComboBox1.Text = "SJIS" Then
            ' 強制的に文字コード変換(SJIS)
            TextBox1.Text = System.Text.Encoding.GetEncoding("SHIFT-JIS").GetString(cod)
        ElseIf ComboBox1.Text = "JIS" Then
            ' 強制的に文字コード変換(JIS)
            TextBox1.Text = System.Text.Encoding.GetEncoding("ISO-2022-JP").GetString(cod)
        ElseIf ComboBox1.Text = "EUC" Then
            ' 強制的に文字コード変換(EUC)
            TextBox1.Text = System.Text.Encoding.GetEncoding("EUC-JP").GetString(cod)
        ElseIf ComboBox1.Text = "UNICODE" Then
            ' 強制的に文字コード変換(UNICODE)
            TextBox1.Text = System.Text.Encoding.GetEncoding("UNICODE").GetString(cod)
        ElseIf ComboBox1.Text = "UTF7" Then
            ' 強制的に文字コード変換(UTF7)
            TextBox1.Text = System.Text.Encoding.GetEncoding("UTF-7").GetString(cod)
        ElseIf ComboBox1.Text = "UTF8" Then
            ' 強制的に文字コード変換(UTF8)
            TextBox1.Text = System.Text.Encoding.GetEncoding("UTF-8").GetString(cod)
        End If
    End Sub