ab.com コミュニティ

'*******************************************************
'  C言語の標準関数String.hのエミュレート with shlwapi.dll (Shell Lightweight Utility APIs)
'  IE Ver4.x以上が必要（Win98以降は標準で付属）。
'
'   Ｃ言語      ActiveBasic言語
'  strncpy()  →  lstrncpy()
'  strncat()  →  lstrncat()
'  strstr()   →  lstrstr()
'  strchr()   →  lstrchr()
'  strrchr()  →  lstrrchr()
'
'  ※引数はC言語のそれとまったく同様。
'  ※lstrcpy(), lstrcat() などは標準で定義済み（Ver4.03時点）
'
'*******************************************************


'lstrncpy()
Declare Function lstrncpy Lib "kernel32" Alias "lstrcpynA" _
                    ( pBuffer1 As BytePtr, _
                      pBuffer2 As BytePtr, _
                      iMaxLength As Long ) As BytePtr

'strncat()
Declare Function lstrncat Lib "shlwapi" Alias "StrNCatA" _
            ( pString1 As BytePtr, _
              pString2 As BytePtr, _
              iMaxLength As Long ) As BytePtr

'strstr()
Declare Function lstrstr Lib "shlwapi" Alias "StrStrIA" _
            ( pBuffer1 As BytePtr, _
              pBuffer2 As BytePtr ) As BytePtr

'strchr()
Declare Function lstrchr Lib "shlwapi" Alias "StrChrIA" _
            ( pBuffer1 As BytePtr, _
              bSearch2 As Byte ) As BytePtr

'strrchr()
Declare Function _lstrrchr Lib "shlwapi" Alias "StrRChrIA" _
            ( pBufStart As BytePtr, _
              pBufEnd As BytePtr, _
              bSearch2 As Byte ) As BytePtr
Function lstrrchr( pBuffer1 As BytePtr, bSearch2 As Byte ) As BytePtr
    lstrrchr = _lstrrchr( pBuffer1, _
                pBuffer1 + lstrlen(pBuffer1), _
                bSearch2 )
EndFunction

Dim lptok As *Char

Function memchr(s As VoidPtr,ch As Long,n As Long) As VoidPtr
Dim i As Long
	For i=0 To n-1
		If GetByte(s+i)=ch Then
			memchr=s+i
			Exit Function
		End If
	Next
	memchr=NULL
End Function

Function strchr(s As *Char,c As Long) As *Char
	strchr=memchr(s,c,lstrlen(s))
End Function

Function strcspn(s1 As *Char,s2 As *Char) As Long
Dim i As Long,j As Long
	For i=0 To lstrlen(s1)-1
		For j=0 To lstrlen(s2)-1
			If s1=s2[j] Then Exit For
		Next
		If j<>lstrlen(s2) Then Exit For
	Next
	strcspn=i
End Function

Function strncat(s1 As *Char,s2 As *Char,n As Long) As *Char
Dim i As Long,Ret As Long
	If lstrlen(s2)<n Then
		strncat=lstrcat(s1,s2)
	Else
		Ret=lstrlen(s1)
		memcpy(s1+Ret,s2,n)
		s1[Ret+n]=Asc(Ex"\0")
		strncat=s1
	End If
End Function

Function strncmp(s1 As *Char,s2 As *Char,n As Long) As Long
Dim Ret As Long
	If n<=lstrlen(s1) And n<=lstrlen(s2) Then
		strncmp=memcmp(s1,s2,n)
	Else
		Ret=Sgn(lstrlen(s1)-lstrlen(s2))
		If Ret<0 Then n=lstrlen(s1) Else n=lstrlen(s2)
		strncmp=memcmp(s1,s2,n)
		If strncmp=0 Then strncmp=Ret
	End If
End Function

Function strncpy(s1 As *Char,s2 As *Char,n As Long) As *Char
	If lstrlen(s2)>=n Then
		memcpy(s1,s2,n)
	Else
		memcpy(s1,s2,lstrlen(s2))
		FillMemory(s1+lstrlen(s2),n-lstrlen(s2),Asc(Ex"\0"))
	End If
End Function

Function strpbrk(s1 As *Char,s2 As *Char) As *Char
Dim dwRet As Long
	dwRet=strcspn(s1,s2)
	If dwRet=lstrlen(s1) Then
		strpbrk=NULL
	Else
		strpbrk=s1+dwRet
	End If
End Function

Function strrchr(s As *Char,c As Long) As *Char
Dim i As Long
	Debug
	For i=lstrlen(s) To 0 Step -1
		If s=c Then
			strrchr=s+i
			Exit Function
		End If
	Next
	s=NULL
End Function

Function strspn(s1 As *Char,s2 As *Char) As Long
Dim i As Long,j As Long
	For i=0 To lstrlen(s1)-1
		For j=0 To lstrlen(s2)-1
			If s1=s2[j] Then Exit For
		Next
		If j=lstrlen(s2) Then Exit For
	Next
	strspn=i
End Function

Function strstr(s1 As *Char,s2 As *Char) As *Char
Dim len1 As Long,len2 As Long,i As Long,i2 As Long,i3 As Long
Dim Flag As Long
	len1=lstrlen(s1)
	len2=lstrlen(s2)

	Flag=-1
	For i=0 To len1-len2
		i2=i:i3=0
		Do
			If i3=len2 Then
				Flag=i
				Exit Do
			End If
			If s1[i2]<>s2[i3] Then Exit Do

			i2=i2+1
			i3=i3+1
		Loop
		If Flag<>-1 Then
			strstr=s1+Flag
			Exit Function
		End If
	Next
	strstr=NULL
End Function

Function strtok(s1 As *Char,s2 As *Char) As *Char
Dim i As Long,j As Long
	If s1=NULL Then
		If lstrlen(lptok)=0 Then
			strtok=NULL
		Else
			For i=0 To lstrlen(lptok)-1
				For j=0 To lstrlen(s2)-1
					If lptok=s2[j] Then
						lptok=Asc(Ex"\0")
						strtok=lptok
						lptok=lptok+i+1
						Exit Function
					End If
				Next
			Next
			strtok=lptok
			lptok=lptok+i+1
		End If
	Else
		If lstrlen(s1)=0 Then
			strtok=NULL
		Else
			For i=0 To lstrlen(s1)-1
				For j=0 To lstrlen(s2)-1
					If s1=s2[j] Then
						s1=Asc(Ex"\0")
						strtok=s1
						lptok=s1+i+1
						Exit Function
					End If
				Next
			Next
			strtok=s1
			lptok=s1+i+1
		End If
	End If
End Function