tagCANDY CGI VBレスキュー(花ちゃん) - バイト単位の文字列切り出し(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
バイト単位の文字列切り出し(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

バイト単位の文字列切り出し(VB6.0) [No.229の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2009/05/16 19:58
名前: 魔界の仮面弁士

***********************************************************************************
* カテゴリー:[文字列処理][基本コード][]                                          *
* キーワード:StrConv,文字コード,変換,半角,全角,Unicode                           *
***********************************************************************************

Left/Mid/Right 関数を、「バイト単位で処理」するための文字列処理関数群です。

1999 年当時に作っていた物。今更不要かと思いましたが、
掲示板の質問に挙がって来たので発掘してみました。

# Mid ステートメントのために、Property Let 実装したバージョンも
# どこかにあるはずなのだけれども、コード喪失…。


Public Function LenA(ByVal Source As String) As Long
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name        : LenA   (Function)
'*:
'*: Descripition: 文字列のANSIバイト数を返します。
'*:
'*: Arguments   : Source  (i)  対象文字列式。
'*:
'*: Return      : SourceのANSI 換算時のバイト数を返します。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
    LenA = LenB(StrConv(Source, vbFromUnicode))
End Function

Public Function LeftA(ByVal Source As String, _
                      ByVal Length As Long, _
             Optional ByVal NoCheck As Boolean = False _
                     ) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name        : LeftA   (Function)
'*:
'*: Descripition: 文字列の左端から指定したANSIバイト数分の文字列を返します。
'*:               16bit版VBのLeftB関数と、ほぼ同じ動作です。
'*:
'*: Arguments   : Source  (i)  この文字列式の左端から文字列が取り出されます。
'*:               Length  (i)  取り出す文字列のバイト数を表す数式を指定します。
'*:               NoCheck [i]  2バイト文字の分断を無視するかどうかを指定します。
'*:                             True  : 2バイト文字分断チェックを行わない
'*:                             False : 2バイト文字分断チェックを行う(規定値)
'*:
'*: Return      : Sourceを左からLengthバイト取り出した文字列を返します。
'*:
'*: Notes       : 2バイト文字が分断される場合は、以下のように処理されます。
'*:                 NoCheck = True の場合:末尾にDBCSの先導バイトが混入します。
'*:                NoCheck = Falseの場合:分断される文字は切り捨てられます。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
    Dim B() As Byte, W() As Byte
    Dim L   As Long
    
    If Length <= 0 Then
        LeftA = ""
        Exit Function
    End If
    
    If NoCheck Then
        B = LeftB$(StrConv(Source, vbFromUnicode), Length)
    Else
        For L = 1 To Length
            W = StrConv(Left$(Source, L), vbFromUnicode)
            If UBound(W) > Length - 1 Then
                Exit For
            Else
                B = W
            End If
        Next L
    End If
    LeftA = StrConv(CStr(B), vbUnicode)
End Function

Public Function RightA(ByVal Source As String, _
                       ByVal Length As Long, _
              Optional ByVal NoCheck As Boolean = False _
                      ) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name        : RightA   (Function)
'*:
'*: Descripition: 文字列の右端から指定したANSIバイト数分の文字列を返します。
'*:               16bit版VBのRightB関数と、ほぼ同じ動作です。
'*:
'*: Arguments   : Source  (i)  この文字列式の右端から文字列を取り出します。
'*:               Length  (i)  取り出す文字列のバイト数を表す数式を指定します。
'*:               NoCheck [i]  2バイト文字の分断を無視するかどうかを指定します。
'*:                             True  : 2バイト文字分断チェックを行わない
'*:                             False : 2バイト文字分断チェックを行う(規定値)
'*:
'*: Return      : Sourceを右からLengthバイト取り出した文字列を返します。
'*:
'*: Notes       : 2バイト文字が分断される場合は、以下のように処理されます。
'*:                 NoCheck = True の場合:先頭にあるDBCS文字をそのまま分断します。
'*:                NoCheck = Falseの場合:分断される文字は切り捨てられます。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
    Dim B() As Byte, W() As Byte
    Dim L   As Long
    
    If Length <= 0 Then
        RightA = ""
        Exit Function
    End If
    
    If NoCheck Then
        B = RightB$(StrConv(Source, vbFromUnicode), Length)
    Else
        For L = 1 To Length
            W = StrConv(RightB$(Source, L), vbFromUnicode)
            If UBound(W) > Length - 1 Then
                Exit For
            Else
                B = W
            End If
        Next L
    End If
    RightA = StrConv(CStr(B), vbUnicode)
End Function

Public Function MidA(ByVal Source As String, _
                     ByVal Start As Long, _
            Optional ByVal Length As Variant, _
            Optional ByVal NoCheck As Boolean = False _
                    ) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name        : MidA   (Function)
'*:
'*: Descripition: 文字列から指定したANSIバイト数分の文字列を返します。
'*:               16bit版VBのMidB関数と、ほぼ同じ動作です。
'*:
'*: Arguments   : Source  (i)  文字列を取り出す、元の文字列式を指定します。
'*:               Start   (i)  Sourceの先頭の位置を1として、どの位置から文字列を
'*:                            取り出すかを、先頭からのバイト数で指定します。
'*:               Length  [i]  取り出す文字列のバイト数を表す数式を指定します。
'*:               NoCheck [i]  2バイト文字の分断を無視するかどうかを指定します。
'*:                             True  : 2バイト文字分断チェックを行わない
'*:                             False : 2バイト文字分断チェックを行う(規定値)
'*:
'*: Return      : Sourceを右からLengthバイト取り出した文字列を返します。
'*:
'*: Notes       : 2バイト文字が分断される場合は、以下のように処理されます。
'*:                 NoCheck = True の場合:先頭にあるDBCS文字をそのまま分断します。
'*:                NoCheck = Falseの場合:分断される文字は切り捨てられます。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
    Dim B() As Byte, W() As Byte
    Dim L   As Long
    Dim lngStart As Long, lngLength As Long
    
    If IsMissing(Length) Then
        lngLength = LenB(MidB(StrConv(Source, vbFromUnicode), Start))
    Else
        lngLength = Length
    End If
    
    If lngLength = 0 Then
        MidA = ""
        Exit Function
    End If
    
    If NoCheck Then
        B = MidB$(StrConv(Source, vbFromUnicode), Start, lngLength)
    Else
        B = ""
        lngStart = Start
        For L = 1 To Start - 1
            If LenA(Left(Source, L)) >= Start - 1 Then
                lngStart = L + 1
                Exit For
            End If
        Next L
    
        For L = 1 To lngLength
            W = StrConv(Mid$(Source, lngStart, L), vbFromUnicode)
            If UBound(W) > lngLength - 1 Then
                Exit For
            Else
                B = W
            End If
        Next L
    End If
    MidA = StrConv(CStr(B), vbUnicode)
End Function

'------------
なお MidA の NoCheck 引数は、全角文字を分断するような指定がなされた場合、
その取扱いを変更するためのものです。

  Source = "≠=!=-"

  A0 = MidA(Source, 1, 4)       '『≠=』
  B0 = MidA(Source, 1, 4, True) '『≠=』

  A1 = MidA(Source, 2, 3)       '『=!』 開始位置を 2 から 3 にずらして取得
  B1 = MidA(Source, 2, 3, True) '『a』 開始位置が全角文字を分断するため、正しい文字列にならない

  A2 = MidA(Source, 2, 4)       '『=!=』開始位置を 2 から 3 にずらして取得
  A2 = MidA(Source, 2, 4, True) '『a・』開始位置と終了位置の両方が全角文字を分断して、正しい文字列にならない

  A3 = MidA(Source, 3, 3)       '『=!』
  B3 = MidA(Source, 3, 3, True) '『=!』

  A4 = MidA(Source, 4, 3)       '『!=-』 開始位置を 4 から 5 にずらして取得
  B4 = MidA(Source, 4, 3, True) '『・=』 開始位置が全角文字を分断するため、正しい文字列にならない

  A5 = MidA(Source, 5, 3)       '『!=-』
  B5 = MidA(Source, 5, 3, True) '『!=-』
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ