ab.com コミュニティ
https://www.activebasic.com/forum/

[AB4]UNICODE対応文字列処理
https://www.activebasic.com/forum/viewtopic.php?t=352
ページ 11

作成者:  マティ [ 2005年9月25日(日) 22:43 ]
記事の件名:  [AB4]UNICODE対応文字列処理

SJIS専用の文字列処理関数群が不人気だったので、Unicode用の専用関数郡を作成しました。
[AB4]で動作確認しました、関数郡はUから始まります。
ULen, ULeft$, URight$, UMid$, UInStrを乗せました。ホームページに、URim,ULRim,URRim等の関数もあります。

この関数郡を使用するには、元データがユニコードである必要があります。
関連関数として、StrConv関数をホームページで準備していますが、"UTF8→Shift-JISへの変換"を応用しても作成可能です。
しかし、データはString型で作成する必要があります。
コード:
'-----------------------------------------------------------
' 文字数を調べる
'-----------------------------------------------------------
Function ULen( Text As String ) As Long
	ULen = Len( Text ) >> 1		'文字数を返す(バイトの半分)
End Function
'-----------------------------------------------------------
' 左側から取り出す
'-----------------------------------------------------------
Function ULeft$( Text As String, nChar As Long ) As String
	If(nChar <= 0)Then Exit Function		'処理不能
	ULeft$ = UStrCopy$( Text, 0, nChar )	'文字列を返す
End Function
'-----------------------------------------------------------
' 右側から取り出す
'-----------------------------------------------------------
Function URight$( Text As String, nChar As Long ) As String
	Dim s As Long
	s = ULen(Text) - nChar
	If(nChar <= 0)Then Exit Function		'処理不能
	If(s	 <  0)Then Exit Function		'処理不能
	URight$ = UStrCopy$( Text, s, nChar )		'文字列を返す
End Function
'-----------------------------------------------------------
' 指定位置から指定分の文字を取り出す!!!
'-----------------------------------------------------------
Function UMid$( Text As String, Start As Long )( nChar As Long ) As String
	Dim n As Long
	If(Start <= 0)Then Exit Function		'処理不能
	If(nChar <  0)Then Exit Function		'処理不能

	n = ULen( Text ) - Start
	If(nChar > n)Or(nChar = 0)Then nChar = n	'最後まで処理する
	UMid$ = UStrCopy$( Text, Start-1, nChar )	'文字列を返す
End Function
'-----------------------------------------------------------
' 文字列中から一致する文字を検索します。
'-----------------------------------------------------------
Function UInStr( 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
	'前処理
	n1=ULen( Text )
	n2=ULen( KeyWord )
	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		'処理不能
	'比較本処理
	UInStr=UTextFind( Start-1, Text, n1-1, KeyWord, n2-1 )
End Function
コード:
'************************************************************************************
' 内部関数です!仕様の変更が多々ありますので、あまり外部から呼び出さないで下さい。
'************************************************************************************
'-----------------------------------------------------------
' 返却用の文字列を作成する
'-----------------------------------------------------------
Function UStrCopy$( Text As WordPtr, nStart As Long, nWord As Long ) As String
	Dim nByte As Long
	If(nWord > 0)Then
		nStart = nStart << 1	'開始位置
		nByte  = nWord  << 1	'必要バイト数
		UStrCopy$ = ZeroString( nByte )					'返却用領域作成
		memcpy( StrPtr(UStrCopy$), Text+nStart, nByte )	'返却文字列コピー
	End If
End Function
'-----------------------------------------------------------
' 文字列検索
'-----------------------------------------------------------
Function UTextFind( Start As Long, Text As WordPtr,n1 As Long, KeyWord As WordPtr,  n2 As Long ) As Long
	Dim i As Long, j As Long, c As Word
	c = KeyWord[0]
	For i=Start to (n1-n2)
		If( Text = c )Then
			For j=1 To n2
				If( Text[i+j] <> KeyWord[j] ) Then Exit For
			Next
			if(j > n2)Then UTextFind=i+1: Exit Function
		End If
	Next
End Function

作成者:  THEREMIN [ 2007年3月10日(土) 21:28 ]
記事の件名: 

UMid$()にバグがあります。
n = ULen( Text ) - Start +1
とするべきです。でないと、最後の文字が取得されなくなってしまいます。
確認も兼ねてbasic\function.sbp のMid$()を参照しましたが、こちらではStartPos=StartPos-1としているようです。
なので、
コード:
Function UMid$( Text As String, Start As Long )( nChar As Long ) As String
	Dim n As Long
	Start = Start-1
	If(Start < 0)Then Exit Function	'処理不能条件
	If(nChar < 0)Then Exit Function	'処理不能条件

	n = ULen( Text ) - Start
	If(nChar > n)Or(nChar = 0)Then nChar = n	'最後まで処理する
	UMid$ = UStrCopy$( Text, Start, nChar )	'文字列を返す
End Function
こんな感じにすると良いと思います。
もしやと思って調べてみたら、URight$()にも同様のバグがありました。

作成者:  THEREMIN [ 2007年3月10日(土) 22:45 ]
記事の件名:  訂正

URight$()にもバグがあると言ったのは間違いでした。
今さっき試してみたらちゃんと動作しました。すみません。

ページ 11 全ての表示時間は UTC+09:00 です
Powered by phpBB® Forum Software © phpBB Limited
https://www.phpbb.com/