+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Pattern matching (/showthread.php?tid=1675)
Pattern matching - eoredson - 05-11-2023
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 SubHowever, 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