vb6 选择字符串中的整个单词

Question

我正在尝试在没有正则表达式的情况下搜索字符串，这可能是个坏主意！

搜索作用于 RichText 框中的文本字符串
如果我搜索“is”，字符串中的第一个单词是“This”
“This”的最后两个字母在 vbRed 中突出显示
要搜索的字符串还有另外两个“is”，它们按预期找到并突出显示

我可以防止“This”中的“is”被找到吗？

Private Sub btnSearch_Click()

Dim pos As Integer
Dim strToFind As String
Dim Y As Integer
Dim Ask As String

pos = 1
strToFind = tbSearch.Text

Do
    strToFind = tbSearch.Text
    pos = InStr(1, strToSearch, strToFind)
    
    For Y = 1 To Len(strToSearch)
       
    Ask = MsgBox("Yes Next Occurrence or No To Exit ?", vbYesNo, "Question")
    
    If Ask = vbYes Then
    lbOne.AddItem pos
    tbAns.Text = pos

        If pos = 0 Then
            Exit Sub
        End If
        
    rtbOne.SelStart = pos - 1
    rtbOne.SelLength = Len(strToFind)
    rtbOne.SelColor = vbRed
    
    pos = InStr(pos + 1, strToSearch, strToFind)
        
    Else
    
    tbAns.Text = "NO"
    pos = InStr(pos + 1, strToSearch, strToFind)
    tbAns.Text = pos
    Exit Sub
    End If

    Next

    Loop Until pos > 0
End Sub

Private Sub Form_Load()

    strToSearch = "This is a lot of text that will be loaded in the lbText and we will search it is it a case sensative Search"
    
    rtbOne.Text = strToSearch
    tbSearch.Text = "is"

End Sub

如果这是不可能的，关于如何使用正则表达式的一些建议
我知道我需要添加参考，这可能是
模式 myRegExp.Pattern = "(.)\strToFind\b(.)"

Answer 1

TOM FindText 接受 tomMatchWord 标志。就用那个。不要随意将文本从控件中提取出来，然后使用 RegEx 之类的慢速脚本语言拐杖来咀嚼它。

Answer 2

我对 Bob77 和 Mark 所建议的“内置”搜索的想法很感兴趣，因此我编写了代码来实现这个想法。该代码使用 WinAPI 调用，但总体上非常简单，并且支持向前和向后移动以及区分大小写和整个单词的切换：

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)

Private Enum Direction
   Forward = 1
   Backward = -1
End Enum

Private Doc As ITextDocument

Private Sub Form_Load()
   RichTextBox1.HideSelection = False
   RichTextBox1.Text = "is This is a lot of text that will be loaded in the lbText and we will " & _
                       "search it is it a case sensative Search" & vbCr & vbCr & _
                       "is and IS and is"
   
   SearchTerm.Text = "is"

   Dim Unknown As IUnknown
   SendMessage RichTextBox1.hwnd, EM_GETOLEINTERFACE, 0&, Unknown
   Set Doc = Unknown
End Sub

Private Sub cmdForward_Click()
   Match SearchTerm.Text, chkWhole.Value, chkCase.Value, Forward
End Sub

Private Sub cmdBack_Click()
   Match SearchTerm.Text, chkWhole.Value, chkCase.Value, Backward
End Sub

Private Sub Match(ByVal SearchTerm As String, ByVal WholeWords As Integer, ByVal CaseSensitive As Integer, ByVal Direction As Direction)
   Dim Flags As Long
   Flags = 2 * WholeWords + 4 * CaseSensitive
   Doc.Selection.FindText SearchTerm, Direction * Doc.Selection.StoryLength, Flags
End Sub

您需要使用 Project|References 中的“Browse...”按钮添加对 RICHED20.dll 的引用。

Answer 3

您可能会发现以下基于VBScript.RegExp 的InStrAll 实现很有用。

Option Explicit

Private Sub Form_Load()
    Const STR_TEXT      As String = "This is a lot of text that will be loaded in the lbText and we will search it is it a case sensative Search"
    Dim vElem           As Variant
    
    For Each vElem In InStrAll(STR_TEXT, "is")
        Debug.Print vElem, Mid$(STR_TEXT, vElem, 2)
    Next
End Sub

Public Function InStrAll(sText As String, sSearch As String, Optional ByVal Compare As VbCompareMethod = vbTextCompare) As Variant
    Dim lIdx            As Long
    Dim vRetVal         As Variant
    
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = (Compare <> vbBinaryCompare)
        .Pattern = "[.*+?^${}()/|[\]\\]"
        .Pattern = "\b" & .Replace(sSearch, "\$&") & "\b"
        With .Execute(sText)
            If .Count = 0 Then
                vRetVal = Array()
            ElseIf .Count = 1 Then
                vRetVal = Array(.Item(0).FirstIndex + 1)
            Else
                ReDim vRetVal(0 To .Count - 1) As Variant
                For lIdx = 0 To .Count - 1
                    vRetVal(lIdx) = .Item(lIdx).FirstIndex + 1
                Next
            End If
        End With
    End With
    InStrAll = vRetVal
End Function

关键是首先你必须转义搜索到的字符串（所有正则表达式控制符号的前缀都带有反斜杠），然后在对所有匹配项执行“全局”搜索之前用\bs 包装这个转义模式。

InStrAll 函数返回原始文本中的索引数组。在您选择的 RichTextBox 控件中实现实际的颜色编码突出显示取决于您。 （如果可以选择，我会设置背景颜色，而不是找到的 sn-p 的前景。请注意大多数浏览器如何使用黄色背景来突出显示搜索结果。）

Answer 4

对于非正则表达式方法，请尝试以下方法：

Option Explicit

Private Sub Form_Load()
   RichTextBox1.Text = "is This is a lot of text that will be loaded in the lbText and we will " & _
                       "search it is it a case sensative Search" & vbCr & vbCr & _
                       "is and is and is"
End Sub

Private Sub Command1_Click()
   Dim SearchTerm As String
   Dim SearchIndex As Integer
   
   SearchTerm = "is"
   SearchIndex = 1
   
   Do
      SearchIndex = InStr(SearchIndex, RichTextBox1.Text, SearchTerm)
      
      If isMatch(SearchIndex, SearchTerm) Then
         RichTextBox1.SelStart = SearchIndex - 1
         RichTextBox1.SelLength = Len(SearchTerm)
         RichTextBox1.SelColor = vbRed
      End If
      
      If SearchIndex > 0 Then SearchIndex = SearchIndex + Len(SearchTerm)
   Loop Until SearchIndex = 0
End Sub

Private Function isMatch(ByVal SearchIndex As Long, ByVal SearchTerm As String) As Boolean
   If SearchIndex = 1 Then
      If Mid(RichTextBox1.Text, SearchIndex + Len(SearchTerm), 1) = " " Then isMatch = True
   ElseIf SearchIndex + Len(SearchTerm) >= Len(RichTextBox1.Text) Then
      If Mid(RichTextBox1.Text, SearchIndex - 1, 1) = " " Then isMatch = True
   ElseIf SearchIndex > 1 Then
      If (Mid(RichTextBox1.Text, SearchIndex - 1, 1) = " " Or Mid(RichTextBox1.Text, SearchIndex - 1, 1) = vbCr) And Mid(RichTextBox1.Text, SearchIndex + Len(SearchTerm), 1) = " " Then isMatch = True
   End If
End Function

如 cmets 中所述，原始代码存在局限性。该代码现在支持文本开头和结尾处的匹配，以及嵌入的中断。您可能需要向 isMatch 方法添加更多检查。