VBCommons/parsers/DetectorListWords.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DetectorListWords"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ====== Single word dictionary detector =======
' Shared module version: 20220623
' Tested in:
' Depends on:
' Required reference: ADODB, Scripting
Option Explicit

Private data_ As Scripting.Dictionary

Public Function Init(sDictionaryPath$)
  Set data_ = New Scripting.Dictionary
  
  On Error Resume Next
  Call LoadFrom(sDictionaryPath)
  On Error GoTo 0
End Function

Public Function Test(sText$) As Boolean
  Test = data_.Exists(VBA.LCase(sText))
End Function

Public Function ExtractFragments(sText$) As PC_ParsedData
  Dim iData As New PC_ParsedData
  
  Dim nStart&: nStart = 1
  Dim nLen&: nLen = VBA.Len(sText)
  Dim nCur&: nCur = nStart
  Do While nCur <= nLen
    If IsDelim(VBA.Mid$(sText, nCur, 1)) Then
      If nCur > nStart Then _
        If Test(VBA.Mid$(sText, nStart, nCur - nStart)) Then _
          Call iData.AddItem(nStart - 1, nCur - 1)
      nStart = nCur + 1
    End If
    nCur = nCur + 1
  Loop
  
  If nCur > nStart Then _
    If Test(VBA.Mid$(sText, nStart, nCur - nStart)) Then _
      Call iData.AddItem(nStart - 1, nCur - 1)
      
  Set ExtractFragments = iData
End Function

' ========
Public Function LoadFrom(sPath$)
  Dim adoStream As New ADODB.Stream
  adoStream.Charset = "utf-8"
  Call adoStream.Open
  Call adoStream.LoadFromFile(sPath)
  
  Dim nLine&: nLine = 1
  Do Until adoStream.EOS
    Dim sItem$: sItem = adoStream.ReadText(adReadLine)
    If sItem <> "" And Not data_.Exists(sItem) Then _
      Call data_.Add(VBA.LCase(sItem), nLine)
    nLine = nLine + 1
  Loop
  
  Call adoStream.Close
End Function

' ==========
Private Function IsDelim(sSymbol$) As Boolean
  IsDelim = True
  If sSymbol = "." Then
    Exit Function
  ElseIf sSymbol = Chr(13) Then
    Exit Function
  ElseIf sSymbol = Chr(10) Then
    Exit Function
  ElseIf sSymbol = "," Then
    Exit Function
  ElseIf sSymbol = ChrW(&H2013) Then _
    Exit Function
  ElseIf sSymbol = ChrW(&H2012) Then _
    Exit Function
  ElseIf sSymbol = ChrW(&H2010) Then _
    Exit Function
  ElseIf sSymbol = ";" Then
    Exit Function
  ElseIf sSymbol = " " Then
    Exit Function
  ElseIf sSymbol = "!" Then
    Exit Function
  ElseIf sSymbol = ":" Then
    Exit Function
  ElseIf sSymbol = "?" Then
    Exit Function
  ElseIf sSymbol = """" Then
    Exit Function
  ElseIf sSymbol = "Chr(85)" Then
    Exit Function
  End If
  IsDelim = False
End Function