文字列チェックを自力実装する

● 文字列チェックを自力実装する ●

このネタのコードを書いていたら、とある壁にぶち当たった。で中途脱落して書いたネタがAPI関数CopyMemoryのすすめである。
下記で登場するMakeInteger関数について書いているので、参照してみるとよいかも。

で、以下は気まぐれに書いてみたロジック。きちんと動くのかは不明。

'メモリコピー
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：上位バイトと下位バイトからInteger値を算出する
' 引  数：(i)HighByte … 上位バイト
'         (i)LowByte  … 下位バイト
' 返り値：Integer値
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function MakeInteger(ByVal HighByte As Byte, ByVal LowByte As Byte) As Integer
    Call CopyMemory(ByVal VarPtr(MakeInteger) + 1, ByVal VarPtr(HighByte), 1)
    Call CopyMemory(ByVal VarPtr(MakeInteger), ByVal VarPtr(LowByte), 1)
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列が半角アルファベット・数字・記号のみであるかを判定する
' 引  数：(i)TargetText … 対象文字列
' 返り値：半角アルファベット・数字のみ…True  そうではない…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsAlNumN(ByVal TargetText As String) As Boolean
    Dim ByteData() As Byte
    Dim i As Long
    Dim CharCode As Integer

    '文字列→バイト変換
    ByteData = TargetText

    For i = 0 To UBound(ByteData) Step 2
        CharCode = MakeInteger(ByteData(i + 1), ByteData(i))
        '半角スペース ～ ~
        If Not (&H20 <= CharCode And CharCode <= &H7E) Then
            Exit Function
        End If
    Next i

    'ここまで来たらTrueを設定して終了
    IsAlNumN = True
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列が全角アルファベット・数字のみであるかを判定する
' 引  数：(i)TargetText … 対象文字列
' 返り値：全角アルファベット・数字のみ…True  そうではない…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsAlNumW(ByVal TargetText As String) As Boolean
    Dim ByteData() As Byte
    Dim i As Long
    Dim CharCode As Integer

    '文字列→バイト変換
    ByteData = TargetText

    For i = 0 To UBound(ByteData) Step 2
        Select Case MakeInteger(ByteData(i + 1), ByteData(i))
            Case &HFF10 To &HFF19 '０～９
            Case &HFF21 To &HFF3A 'Ａ～Ｚ
            Case &HFF41 To &HFF5A 'ａ～ｚ
            Case Else
                Exit Function
        End Select
    Next i

    'ここまで来たらTrueを設定して終了
    IsAlNumW = True
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列がひらがなのみであるかを判定する
' 引  数：(i)TargetText … 対象文字列
' 返り値：ひらがな…True  そうではない…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsHiragana(ByVal TargetText As String) As Boolean
    Dim ByteData() As Byte
    Dim i As Long
    Dim CharCode As Integer

    '文字列→バイト変換
    ByteData = TargetText

    For i = 0 To UBound(ByteData) Step 2
        Select Case MakeInteger(ByteData(i + 1), ByteData(i))
            Case &H3000           '全角スペース
            Case &H309D To &H309E 'ゝ、ゞ(繰り返し文字)
            Case &H3041 To &H3093 'ぁ～ん
            Case Else
                Exit Function
        End Select
    Next i

    'ここまで来たらTrueを設定して終了
    IsHiragana = True
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列が半角カタカナのみであるかを判定する
' 引  数：(i)TargetText … 対象文字列
' 返り値：半角カタカナ…True  そうではない…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsKatakanaN(ByVal TargetText As String) As Boolean
    Dim ByteData() As Byte
    Dim i As Long
    Dim CharCode As Integer

    '文字列→バイト変換
    ByteData = TargetText

    For i = 0 To UBound(ByteData) Step 2
        Select Case MakeInteger(ByteData(i + 1), ByteData(i))
            Case &H20             '半角スペース
            Case &HFF61 To &HFF9F '｡～ﾟ
            Case Else
                Exit Function
        End Select
    Next i

    'ここまで来たらTrueを設定して終了
    IsKatakanaN = True
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列が全角カタカナのみであるかを判定する
' 引  数：(i)TargetText … 対象文字列
' 返り値：全角カタカナ…True  そうではない…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsKatakanaW(ByVal TargetText As String) As Boolean
    Dim ByteData() As Byte
    Dim i As Long
    Dim CharCode As Integer

    '文字列→バイト変換
    ByteData = TargetText

    For i = 0 To UBound(ByteData) Step 2
        Select Case MakeInteger(ByteData(i + 1), ByteData(i))
            Case &H3000           '全角スペース
            Case &H30FC           'ー
            Case &H30FD To &H30FE 'ヽ、ヾ(繰り返し文字)
            Case &H30A1 To &H30F6 'ァ～ヶ
            TCase Else
                Exit Function
        End Select
    Next i

    'ここまで来たらTrueを設定して終了
    IsKatakanaW = True
End Function

戻る