SJIS専用の文字列処理関数群を作成しました。
[AB4]で動作確認しました関数名からKを取ると標準の関数と互換になっていると思います。
KLen, KLeft$, KRight$, KMid$, KInStrを乗せました。
ホームページに、KRim,KLRim,KRRim等の関数もあります
[AB4]はString型が非推奨になっていますので、AP側でバッファーを持つ形式の関数を準備するつもりですが、APIを決めかねています。皆さんの知恵をお貸し下さい。
コード:
Const MaxCharactors = &h10000000 '最大文字数
'-----------------------------------------------------------
' 文字数を調べる
'-----------------------------------------------------------
Function KLen( Text As BytePtr ) As Long
KLen = KNumChar( Text ) '文字数を返す
End Function
'-----------------------------------------------------------
' 左側から取り出す
'-----------------------------------------------------------
Function KLeft$( Text As String, nChar As Long ) As String
If(nChar <= 0)Then Exit Function '処理不能
KLeft$ = KStrCopy$( Text, 0, KNumByte(Text, nChar) ) '文字列を返す
End Function
'-----------------------------------------------------------
' 右側から取り出す
'-----------------------------------------------------------
Function KRight$( Text As String, nChar As Long ) As String
Dim b As Long, s As Long
If(nChar <= 0)Then Exit Function '処理不能
s = KNumByte( StrPtr(Text) , KNumChar( Text ) - nChar ) '開始バイト
b = Len( Text ) - s '転送バイト数
KRight$ = KStrCopy$( Text, s, b ) '文字列を返す
End Function
'-----------------------------------------------------------
' 指定位置から指定分の文字を取り出す!!!
'-----------------------------------------------------------
Function KMid$( Text As String, Start As Long )( nChar As Long ) As String
Dim b As Long, s As Long
If(Start <= 0)Then Exit Function '処理不能
If(nChar < 0)Then Exit Function '処理不能
If(nChar = 0)Then nChar = MaxCharactors '最後まで処理する
s = KNumByte( StrPtr(Text) , Start-1 ) '開始バイト
b = KNumByte( StrPtr(Text)+s, nChar ) '転送バイト数
KMid$ = KStrCopy$( Text, s, b ) '文字列を返す
End Function
'-----------------------------------------------------------
' 文字列中から一致する文字を検索します。
'-----------------------------------------------------------
Function KInStr( Start As Long, Text As String, KeyWord As String ) As Long
Dim i As Long, j As Long, n As Long, c As Byte
Dim n1 As Long, n2 As Long
Dim b1 As Long, b2 As Long
'前処理
KCheckEx( Text, MaxCharactors, n1, b1 )
KCheckEx( KeyWord, MaxCharactors, n2, b2 )
If((n1 - Start + 1) < n2 )Then Exit Function '処理不能
If(n2 = 0)Then Exit Function '処理不能
If(Start <= 0)Then Exit Function '処理不能
If(Start > n1)Then Exit Function '処理不能
'比較本処理
n = Start: i = KNumByte( StrPtr(Text), n-1 )
Do
c = Text
If( KeyWord[0] = c )Then
For j=1 To (b2 - 1)
If( Text[i+j] <> KeyWord[j] ) Then Exit For
Next
if(j = b2)Then KInStr=n: Exit Function
End If
n = n + 1
i = i + 1 - ((((c >> 1)Xor c)And &hA0) = &h80) '2Byte?
Loop
End Function
コード:
'************************************************************************************
' 内部関数です!仕様の変更が多々ありますので、あまり外部から呼び出さないで下さい。
'************************************************************************************
'-----------------------------------------------------------
' 指定した文字数までのバイト数を調べる(文字数指定あり)
'-----------------------------------------------------------
Function KNumByte( Text As BytePtr, nChar As Long) As Long
Dim Dummy As Long 'Dummyデータ
KCheckEx( Text, nChar, Dummy, KNumByte ) 'バイト数を返す
End Function
'-----------------------------------------------------------
' 文字列の文字数を調べる
'-----------------------------------------------------------
Function KNumChar( Text As BytePtr ) As Long
Dim Dummy As Long 'Dummyデータ
KCheckEx( Text, MaxCharactors, KNumChar, Dummy )'文字数を返す
End Function
'-----------------------------------------------------------
' 文字列の文字数&バイト数を調べる(文字数指定あり)
'-----------------------------------------------------------
Sub KCheckEx( Text As BytePtr, nLen As Long, ByRef nChar As Long, ByRef nByte As Long)
Dim n As Long, i As Long, c As Byte
'
If(nLen > 0)Then
Do
c = Text(i): if(c = 0)Then Exit Do
i = i + 1 - ((((c >> 1)Xor c)And &hA0) = &h80) '2Byte?
n = n + 1
Loop While ( n < nLen )
End If
nByte = i 'バイト数
nChar = n '文字数
End Sub
'-----------------------------------------------------------
' 返却用の文字列を作成する
'-----------------------------------------------------------
Function KStrCopy$( Text As String, nStart As Long, nByte As Long ) As String
If(nByte > 0)Then
KStrCopy$ = ZeroString( nByte ) '返却用領域作成
memcpy( StrPtr(KStrCopy$), StrPtr(Text)+nStart, nByte ) '返却文字列コピー
End If
End Function