How do I change my string permute class so that it handles strings longer than 1 char

[tmighty2]

Hello!

I want to recognize strings that a young child inputs even though it may contain spelling errors.
My first language is not English, but I try to explain it in English anyway:

The child might enter "kar" (because it thinks it's written this way), and my software should recognize "car".

What I did was:

I created a class and fed it the input "k", "c".
The class would then create all permutations of the children's input.

So if the child would enter "kar", it would produce
"kar, car"

If I also fed the input "o", "a", and the child enters "kor", the class would produce

"kor, kar, cor, car".

This works fine.

However, I would now like to feed it strings longer than 1 character.

For example:

"rac", "car".

So if the child would enter "rac", it would produce

"rac, car".

However, this does not work with my permutation approach. My permutation approach deals with single characters only.

Can anybody tell me how I could change my class so that it can handle strings that are longer than 1 character?

Thank you!

permute.zip

Here is the code of Form1 (it requires a ListBox named "List1"):

Option Explicit

Private Type udtReplacement
    Original As String
    Replacement As String
End Type

Private Sub Form_Load()

    Dim nReplacements(3) As udtReplacement

    nReplacements(1).Original = "a"
    nReplacements(1).Replacement = "x"
    
    nReplacements(2).Original = "kah"
    nReplacements(2).Replacement = "car"
    
    nReplacements(3).Original = "b"
    nReplacements(3).Replacement = "y"
    
    Dim sText$
    sText = "kahb"

    'For permutation results I expect this:

    'kahb
    'kxhb
    'kxhy
    'kahy
    'carb 'this does not work because my class can only handle single characters
    'cary 'this does not work because my class can only handle single characters
  
    Dim p&
    For p = 1 To UBound(nReplacements)
        
        Dim CP As clsStringPermutate
        Set CP = New clsStringPermutate
        
        Dim sRes() As String
        sRes = CP.Permute(sText, nReplacements(p).Original, nReplacements(p).Replacement)
        
        If UBound(sRes) > 0 Then
            Dim r&
            For r = 0 To UBound(sRes) - 1
                Me.List1.AddItem sRes(r)
            Next r
        End If
        
    Next p

End Sub

And this is the clsStringPermutate:

Option Explicit

Private m_InputString As String
Private m_EquiChar() As String
Private m_Result() As String
Private m_TempResult() As String
Private m_IndexIntoString() As Integer
Private m_IndexIntoChar() As Integer
Private m_TotalOccurance&
Private m_NumberOfResults&

Public Function GetReplacementStrings(lp As Integer) As String

    If lp = m_TotalOccurance Then
        ReplaceByMap
    Else
       Dim i As Integer
       i = 0
       Do While i < UBound(m_EquiChar) + 1
            ReDim Preserve m_IndexIntoChar(UBound(m_IndexIntoChar) + 1)
            m_IndexIntoChar(lp) = i
            GetReplacementStrings (lp + 1)
            i = i + 1
       Loop
       m_IndexIntoChar(lp) = 0
    End If
    
End Function

Public Function Permute(inputStr As String, s1 As String, s2 As String) As String()

    m_InputString = inputStr
    ReDim m_IndexIntoString(0)
    ReDim m_IndexIntoChar(0)
    ReDim m_TempResult(0)
    ReDim m_EquiChar(1)
    m_NumberOfResults = 0
    m_TotalOccurance = 0
    
    m_EquiChar(0) = s1
    m_EquiChar(1) = s2
    
    Prepare
    
    If (m_TotalOccurance = -1) Then
        ReDim m_Result(0)
        Permute = m_Result()
        Exit Function
    End If
    
    GetReplacementStrings (0)
    
    ReDim m_Result(m_NumberOfResults)
    Dim i As Integer
        For i = 0 To m_NumberOfResults - 1
        m_Result(i) = m_TempResult(i)
    Next i
    
    Permute = m_Result()

End Function

Private Function IsExists(inputStr As String) As Boolean

    Dim i As Integer
    For i = 0 To UBound(m_TempResult)
        If VBA.Len(m_TempResult(i)) = 0 Then
            IsExists = False
            Exit Function
        ElseIf m_TempResult(i) = inputStr Then
            IsExists = True
            Exit Function
        End If
    Next i
    IsExists = False
    
End Function

Public Function ReplaceByMap() As String

    Dim s As String
    s = m_InputString
    
    Dim i&
    For i = 0 To m_TotalOccurance - 1
        Dim y As Integer
        y = m_IndexIntoString(i)

        Dim s1 As String
        Dim s2 As String
        Dim s3 As String
        s1 = VBA.Left(s, y - 1)
        s2 = VBA.Left(m_EquiChar(m_IndexIntoChar(i)), 1)
        s3 = VBA.Right(s, VBA.Len(s) - y)
        
        s = s1 & s2 & s3
        
        If (Not IsExists(s)) Then
            ReDim Preserve m_TempResult(UBound(m_TempResult) + 1)
            m_TempResult(m_NumberOfResults) = s
            m_NumberOfResults = m_NumberOfResults + 1
        End If
    Next i

End Function

Public Sub Prepare()

    Dim i&
    For i = 0 To UBound(m_EquiChar())
        PrepareOccurenceList (i)
    Next i
    
End Sub

Private Sub PrepareOccurenceList(Index As Integer)

    Dim occurrenceAt As Integer
    occurrenceAt = VBA.InStr(1, m_InputString, m_EquiChar(Index))
    Do While (occurrenceAt <> 0)
       m_TotalOccurance = m_TotalOccurance + 1
        ReDim Preserve m_IndexIntoString(UBound(m_IndexIntoString) + 1)
        m_IndexIntoString(m_TotalOccurance - 1) = occurrenceAt
        occurrenceAt = VBA.InStr(occurrenceAt + 1, m_InputString, m_EquiChar(Index))
    Loop
    
End Sub