BHT-BASICでLike演算子を実現

BHT-BASICにはLike演算子はなくそれに匹敵する関数もないため自分で作ることにした。

作成したのはLike関数でパターン文字列は＊と？にのみ対応している


作成・デバッグはすべてVB6で行なった。←　こんなことができるのもBHT-BASICのいいところです。

BHT-BASIC4.0を対象にしたが、複雑ではないので3.5でも動くかも？？

'//--------------------------------------------------------------
'//Like%(比較文字列,パターン)
'//引数:
'// 比較文字列
'//    おそらく255文字以内
'// パターン文字は次の文字に対応
'//  ? 任意の１文字
'//  * 任意の数の文字
'//戻り値：
'//  一致の場合は-1(True)
'//  不一致の場合は0(False)
'//--------------------------------------------------------------
    Function Like%(paramSource$, paramPattern$)

'//VB6デバック用
'//        Dim srcLen%
'//        Dim ptnLen%
'//        Dim char$
'//        Dim target$
'//        Dim pos%
'//        Dim tmppos%
'//        Dim lp1%
'//        Dim lp2%
'//        Dim lp3%
'//        Dim result%
'//        Dim fflag%

        Const resMatch   = -1
        Const resNoMatch = 0
        
        Private srcLen%
        Private ptnLen%
        Private char$[1]
        Private target$[255]
        Private pos%
        Private tmppos%
        Private lp1%
        Private lp2%
        Private lp3%
        Private result%
        Private fflag%

        srcLen% = Len(paramSource$)
        ptnLen% = Len(paramPattern$)
        If srcLen% > 0 And ptnLen% > 0 Then
            result% = resMatch
            lp2% = 1
            For lp1% = 1 To srcLen%
                 '//パターンが終わったのにまだ比較文字列が残っている場合は不一致
                If lp2% > ptnLen% Then
                    result% = resNoMatch
                    Exit For
                End If
                
                '//パターンから1文字取り出し
                char$ = Mid$(paramPattern$, lp2%, 1)
                Select Case char$
                '// ワイルドカード　？　の処理
                Case "?"
                    '//次の比較する文字へポインターを移動
                    lp2% = lp2% + 1
                
                '// ワイルドカード　＊　の処理
                Case "*"
                    If lp2% = ptnLen% Then
                        '//比較文字列の最後が*の場合、これ以上比較する必要はない
                        Exit For
                    End If
                    
                    '//＊の次の文字から　次の＊or？までを取り出し、検索文字列とする
                    lp2% = lp2% + 1
                    pos% = ptnLen%
                    tmppos% = InStr(lp2%, paramPattern$, "*")
                    If tmppos% <> 0 And pos% >= tmppos% Then
                        pos% = tmppos% - 1
                    Else
                        tmppos% = InStr(lp2%, paramPattern$, "?")
                        If tmppos% <> 0 And pos% >= tmppos% Then
                            pos% = tmppos% - 1
                        End If
                    End If
                    target$ = Mid$(paramPattern$, lp2%, (pos% - lp2%) + 1)
                    
                    '//検索文字列を使って後方から検索
                    fflag% = 0
                    For lp3% = srcLen% To lp1% Step -1
                        If target$ = Mid$(paramSource$, lp3%, Len(target$)) Then
                            '//比較される文字列ポインターを見つかった場所へ変更(ForNextでまわしている関係)
                            lp1% = lp3% + Len(target$) - 1
                            lp2% = pos% + 1
                            fflag% = -1
                            Exit For
                        End If
                    Next lp3%
                    
                     '//検索して見つからない場合は不一致
                    If fflag% = 0 Then
                        result% = resNoMatch
                        Exit For
                    End If
                    
                
                '// ワイルドカード以外の処理(単純に1文字比較)
                Case Else
                    If char$ <> Mid$(paramSource$, lp1%, 1) Then
                        result% = resNoMatch
                        Exit For
                    Else
                        lp2% = lp2% + 1
                    End If
                End Select
            Next
            
            '//比較文字列がすべて終わったのに、まだパターンが残っている場合は不一致
            If lp1% - 1 = srcLen% And lp2% - 1 <> ptnLen% Then
                result% = resNoMatch
            End If
        Else
            result% = resNoMatch
        End If

        Like% = result%
    End Function