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


Possibly Related Threads…
Thread Author Replies Views Last Post
  Makes shift lights blink in a binary pattern eoredson 1 626 06-04-2024, 03:56 AM
Last Post: SMcNeill
  Circular Pattern Using Triangles SierraKen 2 698 10-12-2022, 04:45 PM
Last Post: SierraKen

Forum Jump:


Users browsing this thread: 1 Guest(s)