Search text

[LorinM]

I need help with this code.

I have a string containing multiple lines of text.

I need to be able to detect if a match to my criteria exists.

Say using Like for detecting ambiguous test and some AND and OR operators to do matching.

I have tried and made a big mess of it all and cannot get my head around it.

For example say the operators are {OR} and {AND} but others are ok.

Example search searches:
(d?g{OR}c*t){AND}(rather b?g{OR}Kind of smal*)

Not stuck on () or {} as there may be better ways of doing it.

I there is one match, then return True and it is done. One match is all that is required.

I cannot use RegX. Too complex for the user.

Thank you.

[Eduardo-]

Nice business model: have someone else do the work and you get paid.
Clever.

[Zvoni]

Haven't understood a word.
First post could have been written in chinese

[xiaoyao]

Nani, I've never heard of such a problem.

[Arnoutdv]

Maybe this can be of any help to you.
It first creates a Reverse Polish Notation of the search string.
Then for all elements in the RPN it either evaluates the operators (AND, OR) or it checks the for a string match

Option Explicit

Private Sub Form_Load()
  Dim sSearchText As String
  Dim sSource As String
  
  ' Search for:
  '   d?g {AND} rather b?g
  '   {OR}
  '   c*t {AND} Kind of smal*
  sSearchText = LCase$("(d?g&rather b?g)|(c*t&Kind of smal*)")
  
  sSource = "The dog was rather big"
  Debug.Print pSearch(sSource, sSearchText)

  sSource = "the cat was rather big"
  Debug.Print pSearch(sSource, sSearchText)

  sSource = "the cat was kind of small"
  Debug.Print pSearch(sSource, sSearchText)

End Sub

Private Function pSearch(ByVal sSource As String, ByVal sSearchText As String) As Boolean
  Dim aRPN() As String, lRPN As Long
  Dim bStack() As Boolean, lStack As Long
  
  sSource = Replace(sSource, ",", "")
  sSource = Replace(sSource, ".", "")
  sSource = Replace(sSource, "?", "")
  sSource = Replace(sSource, "!", "")
  sSource = Trim$(sSource)
  
  aRPN = Split(Infix2RPN(sSearchText), vbTab)
  ReDim bStack(1 + (UBound(aRPN) / 2))
  lStack = -1
  For lRPN = 0 To UBound(aRPN)
    Select Case aRPN(lRPN)
      Case "&": bStack(lStack - 1) = bStack(lStack - 1) And bStack(lStack): lStack = lStack - 1
      Case "|": bStack(lStack - 1) = bStack(lStack - 1) Or bStack(lStack):  lStack = lStack - 1
      Case Else
        lStack = lStack + 1
        bStack(lStack) = pSearchPart(sSource, aRPN(lRPN))
    End Select
  Next lRPN
  pSearch = bStack(0)
End Function

Private Function pSearchPart(sSource As String, ByVal sSearch As String) As Boolean
  Dim lNofSearchWords As Long, lNofWords As Long
  Dim lWord As Long, sWord As String
  Dim bLike As Boolean
  
  sSearch = Trim$(sSearch)
  lNofWords = mvCount(sSource, " ")
  lNofSearchWords = mvCount(sSearch, " ")
  
  If InStr(1, sSearch, "?", vbBinaryCompare) Then bLike = True
  If InStr(1, sSearch, "*", vbBinaryCompare) Then bLike = True
  
  For lWord = 1 To lNofWords
    sWord = mvField(sSource, " ", lWord, lNofSearchWords)
    If sWord Like sSearch Then
      pSearchPart = True
      Exit For
    End If
  Next lWord
  
End Function

'---------------------------------------------------------------------------------------
' Procedure : Infix2RPN
' DateTime  : Nov 15, 2005
' Author    : Erik Oosterwal
' Purpose   : Routine to convert infix notation to RPN notation
' Source    : https://sites.google.com/site/computersciencesourcecode/conversion-algorithms/infix-to-rpn
' Revision  : Sep 11, 2008, Arnoutdv
'---------------------------------------------------------------------------------------
Public Function Infix2RPN(sExpression As String) As String
  Dim sWork As String
  Dim sSep As String, sStack(999) As String, sChar As String
  Dim lIndex As Long, lStack As Long
  
  sSep = vbTab      ' Set the token separator
  lIndex = 1        ' Start by looking at the first character in the input string
  lStack = 1        ' Start the operator stack at 1
  sWork = ""        ' Clear the output sting

  ' As long as there's characters in the string
  Do While lIndex <= Len(sExpression)

    ' get the next character.
    sChar = Mid$(sExpression, lIndex, 1)
    
    Select Case sChar
      Case "("
        ' Open parentheses get pushed on the stack
        sStack(lStack) = sChar
        lStack = lStack + 1
          
      Case ")"
        ' If we find a closing parenthesis clear the stack until we
        ' get to the opening parenthesis.
        Do While lStack > 1 And sStack(lStack - 1) <> "("
          sWork = sWork + sSep + sStack(lStack - 1)
          lStack = lStack - 1
        Loop
        ' Decrease the stack pointer to overwrite the opening parenthesis.
        lStack = lStack - 1
          
      Case "&", "|"
        ' Boolean operators & = AND, | = OR
        ' Append a token separator to the output string.
        sWork = sWork + sSep
          
        ' If there are any operators on the stack pop them off
        ' the stack and append them to the output string.
        Do While lStack > 1 And sStack(lStack - 1) <> "("
          sWork = sWork + sStack(lStack - 1) + sSep
          lStack = lStack - 1
        Loop
        ' Push the low operator on the stack.
        sStack(lStack) = sChar
        lStack = lStack + 1
            
      Case Else
        ' Numbers and variables get appended directly to the output string.
        sWork = sWork + sChar
          
    End Select
    
    ' Set the pointer to look at the next character
    lIndex = lIndex + 1
    
  Loop
  
'   All the input characters have been taken care of, now it's time to clear the stack.
  Do While lStack > 1
    ' As long as there's still operators on the stack
    ' take one off and append it to the output string
    sWork = sWork + sSep + sStack(lStack - 1)
    ' look at the previous operator
    lStack = lStack - 1
  Loop

  ' Separated by Chr$(1)
  Infix2RPN = sWork
End Function

Public Function mvCount(sString As String, sSeparator As String) As Long
  Dim lPos As Long
  
  If Len(sString) = 0 Then Exit Function
  
  lPos = 0: mvCount = 1
  Do
    lPos = InStr(lPos + 1, sString, sSeparator, vbBinaryCompare)
    If lPos > 0 Then mvCount = mvCount + 1
  Loop Until lPos = 0
End Function

Public Function mvField(sString As String, sSeparator As String, ByVal lFieldNo As Long, Optional ByVal lNofFields As Long = 1) As String
  Dim lCurElem As Long, lLastElem As Long
  Dim lPos1 As Long, lPos2 As Long, lStart As Long
  
  If lFieldNo < 1 Then Exit Function
  
  lLastElem = lFieldNo + lNofFields - 1
  lPos2 = 1: lPos1 = 1: lStart = 1
  Do While lPos1 > 0
    lCurElem = lCurElem + 1
    lPos1 = InStr(lPos2, sString, sSeparator, vbBinaryCompare)
    If lCurElem = lFieldNo Then lStart = lPos2
    If lCurElem = lLastElem Or lPos1 = 0 Then
      If lPos1 = 0 Then
        If lCurElem >= lFieldNo Then mvField = Mid$(sString, lStart)
      Else
        mvField = Mid$(sString, lStart, lPos1 - lStart)
      End If
      Exit Do
    End If
    lPos2 = lPos1 + Len(sSeparator)
  Loop
End Function

[LorinM]

Thanks for the code. I will explore it.
To conclusion jumpers who have no useful input - This is not for commercial use. For my family use !!!!
I never have done for commercial use since I retired in 2008.
What have you done for your country ?

[LorinM]

Thank you Arnoutdv !
I ran it and it look like a winner for me.
I will put it through the paces and exhaust my ability to check it out, but so far WOW !
InFix to RPN is new terminology to me.
I know RPN but what is InFix in this context ?

[LorinM]

I think this is a longshot however is it possible to get the character position in the text ?

[Arnoutdv]

Thank you Arnoutdv !
I ran it and it look like a winner for me.
I will put it through the paces and exhaust my ability to check it out, but so far WOW !
InFix to RPN is new terminology to me.
I know RPN but what is InFix in this context ?

English is not my native language, but in this context there is infix and postfix.
Infix: A or B, a subject an operator and the next subject
Postfix: A B or, 2 subjects and their operator

https://www.geeksforgeeks.org/conver...ix-expression/

I think this is a longshot however is it possible to get the character position in the text ?

Pfff, I’m afraid that’s quite hard

[Phill.W]

InFix to RPN is new terminology to me.
I know RPN but what is InFix in this context ?

"InFix" is how you or I might write the expression:

( [like "d?g"] OR [like "c*t"] ) AND ( [like "rather b?g"] OR [like "Kind of smal*"] )

"PostFix" or Reverse Polish Notation is closer to the way that most [stack-based] computers will process it:

[like "d?g"]   [like "c*t"]   OR   [like "rather b?g"]   [like "Kind of smal*"]   OR   AND

Regards, Phill W.

[Zvoni]

Remember in RPN, that you are responsible to respect Operator-Precedence.

EDIT: Just saw it

What about "rather big dog"

(d?g{OR}c*t){AND}(rather b?g{OR}Kind of smal*)

Should that return True or False?