Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Pattern matching
#1
This code sample contains a subroutine to match substrings similar to Instr but with ? and * characters:

Code: (Select All)
' function to match case-sensitive substring with ?, * characters in substring
'  input: VarQ = -1 for case-sensitive
'    Var1$ is search string
'    Var2$ is string being searched
'  output: Var = -1 search string matched
Sub InstrSUB1 (Var, Var1$, Var2$, VarQ)

    ' store case-sensitive string match variables
    If VarQ Then
        S2$ = Var1$
        S3$ = Var2$
    Else
        S2$ = LCase$(Var1$)
        S3$ = LCase$(Var2$)
    End If

    ' check default instr
    If InStr(S2$, "*") = 0 Then
        If InStr(S2$, "?") = 0 Then
            Var = InStr(S3$, S2$)
            Exit Sub
        End If
    End If

    Var = -1 ' assume match

    ' asterick always matches
    If Var1$ = "*" Then
        Exit Sub
    End If

    ' see if S2$ matches in S3$ with substrings
    For S3 = 1 To Len(S3$)
        S1$ = Mid$(S3$, S3)
        P1 = 1 ' pointer to S1$
        P2 = 1 ' pointer to S2$
        Do
            ' check match
            If P2 > Len(S2$) Then
                Exit Sub
            End If

            ' check character in S2$ at P2
            V$ = Mid$(S2$, P2, 1)
            Select Case V$
                Case "*" ' global character
                    ' scan to next char
                    If P2 > Len(S2$) Then
                        Exit Do
                    End If
                    S4$ = Mid$(S2$, P2 + 1, 1)
                    Select Case S4$
                        Case "*", "?"
                            P2 = P2 + 1
                        Case Else
                            Do
                                If Mid$(S1$, P1, 1) = S4$ Then
                                    Exit Do
                                End If
                                If P1 >= Len(S1$) Then
                                    Exit Do
                                End If
                                P1 = P1 + 1
                            Loop
                            P2 = P2 + 1
                    End Select
                Case "?" ' wildcard character
                    P1 = P1 + 1
                    P2 = P2 + 1
                Case Else ' ascii character
                    If Mid$(S1$, P1, 1) <> V$ Then ' no match
                        Exit Do
                    End If
                    P1 = P1 + 1
                    P2 = P2 + 1
            End Select
        Loop
    Next
    Var = 0 ' no match
End Sub


However, this code matches filenames with ?, *, and ^ characters;

Code: (Select All)
' routine compares occurrence of filename1$ in filename2$
' with pattern matching.
Function CheckExcluded (Filename1$, Filename2$)
    Print "Compare "; Filename1$; " to "; Filename2$
    CheckExcluded = -1 ' assume mask matches filename2.
    Length1 = 1
    Length2 = 1
    Do
        ' global replacement.
        If Mid$(Filename1$, Length1, 1) = "*" Then
            Do
                Length1 = Length1 + 1
                If Length1 > Len(Filename1$) Then
                    Exit Function
                End If
                ' global replacement followed by exclusion character.
                ' searches remaining string until exclusion character found or not.
                If Mid$(Filename1$, Length1, 1) = "^" Then
                    Length1 = Length1 + 1
                    Not.Include$ = Mid$(Filename1$, Length1, 1)
                    Do
                        If Not.Include$ <> Mid$(Filename2$, Length2, 1) Then
                            Length2 = Length2 + 1
                        Else
                            CheckExcluded = False
                            Exit Function
                        End If
                        If Length2 > Len(Filename2$) Then
                            Exit Function
                        End If
                    Loop
                End If
                ' global replacement followed by ? or another *
                ' skips to next character.
                If Mid$(Filename1$, Length1, 1) <> "*" Then
                    If Mid$(Filename1$, Length1, 1) <> "?" Then
                        Exit Do
                    End If
                End If
            Loop
            ' global replacement.
            ' searches for next matching character.
            Do
                If Mid$(Filename1$, Length1, 1) = Mid$(Filename2$, Length2, 1) Then
                    Exit Do
                Else
                    Length2 = Length2 + 1
                End If
                If Length2 > Len(Filename2$) Then
                    Exit Do
                End If
            Loop
        Else
            ' character replacement.
            ' matches any next character.
            If Mid$(Filename1$, Length1, 1) = "?" Then
                Length1 = Length1 + 1
                Length2 = Length2 + 1
            Else
                ' exclusion character.
                ' checks next character unmatched.
                If Mid$(Filename1$, Length1, 1) = "^" Then
                    Length1 = Length1 + 1
                    Not.Include$ = Mid$(Filename1$, Length1, 1)
                    If Not.Include$ <> Mid$(Filename2$, Length2, 1) Then
                        Length1 = Length1 + 1
                        Length2 = Length2 + 1
                    Else
                        CheckExcluded = False
                        Exit Do
                    End If
                Else
                    ' matches next character.
                    If Mid$(Filename1$, Length1, 1) = Mid$(Filename2$, Length2, 1) Then
                        Length1 = Length1 + 1
                        Length2 = Length2 + 1
                    Else
                        CheckExcluded = False
                        Exit Do
                    End If
                    ' check string lengths.
                    If Length1 > Len(Filename1$) Then
                        If Length2 <= Len(Filename2$) Then
                            CheckExcluded = False
                        End If
                        Exit Do
                    End If
                End If
            End If
        End If
    Loop
End Function
Reply


Messages In This Thread
Pattern matching - by eoredson - 05-11-2023, 06:08 AM



Users browsing this thread: 1 Guest(s)