ab.com コミュニティ

コード: 全て選択

Re: [AB3] InStrの誤認識への対策 ( No.2 ) 
日時： 2004/03/02 18:08
名前： hira  <hira@pc.707.to>
参照： http://hiras.web.poporo.net/ 


「執念の」InStr4関数です。以前よりかなり高速ですが、Unicodeへの変換があるためInStr3には勝てない模様…(--;

Declare Function MultiByteToWideChar Lib "kernel32" (CodePage As Long,dwFlags As Long,lpMultiByteStr As String,cchMultiByte As Long,lpWideCharStr As String,cchWideChar As Long)As Long

Function InStr4(StartPos As Long, buf1 As String, buf2 As String) As Long
Dim len1 As Long,len2 As Long
Dim uni1 As WordPtr,uni2 As WordPtr
Dim Ret As Long
Dim i As Long,i2 As Long,i3 As Long
Dim StartPos2 As Long

        'データのチェック
        If StartPos<0 Or StartPos>Len(buf1) Then Exit Function
        If Len(buf2)=0 Then Exit Function

        len1=MultiByteToWideChar(0,0,buf1,Len(buf1),0,0)
        uni1=HeapAlloc(GetProcessHeap(),0,len1*2)
        MultiByteToWideChar(0,0,buf1,Len(buf1),uni1,len1*2)
        len2=MultiByteToWideChar(0,0,buf2,Len(buf2),0,0)
        uni2=HeapAlloc(GetProcessHeap(),0,len2*2)
        MultiByteToWideChar(0,0,buf2,Len(buf2),uni2,len2*2)

        i=MultiByteToWideChar(0,0,buf1,StartPos-1,0,0)
        Ret=0

        While i<=len1-len2
                i2=i:i3=0
                Do
                        If i3=len2 Then
                                Ret=i*2+1
                                Exit Do
                        End If
                        If uni1[i2]<>uni2[i3] Then Exit Do

                        i2=i2+1
                        i3=i3+1
                Loop
                If Ret Then Exit While
                i=i+1
        Wend

        'Shift-JISに換算した長さを返す
        If Ret Then
                InStr4=(Ret-1)\2+1
                For i=0 To (Ret-1)\2
                        If GetByte(uni1+i*2+1) Then InStr4=InStr4+1
                Next i
        End If

        HeapFree(GetProcessHeap(),0,uni1)
        HeapFree(GetProcessHeap(),0,uni2)
End Function