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
SJIS専用の文字列処理関数群を作成しました。 [AB4]で動作確認しました関数名からKを取ると標準の関数と互換になっていると思います。 [b]KLen, KLeft$, KRight$, KMid$, KInStr[/b]を乗せました。[url=http://www14.plala.or.jp/matea/]ホームページ[/url]に、KRim,KLRim,KRRim等の関数もあります
[AB4]はString型が非推奨になっていますので、AP側でバッファーを持つ形式の関数を準備するつもりですが、APIを決めかねています。皆さんの知恵をお貸し下さい。 [code] 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[i] 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 [/code][code] '************************************************************************************ ' 内部関数です!仕様の変更が多々ありますので、あまり外部から呼び出さないで下さい。 '************************************************************************************ '----------------------------------------------------------- ' 指定した文字数までのバイト数を調べる(文字数指定あり) '----------------------------------------------------------- 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 [/code]
|