Implement Phonetic ("Sounds-like") Name Searches with Double Metaphone Part V: .NET Implementation

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "VB Word Lookup - Double Metaphone Sample"
   ClientHeight    =   3975
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5070
   LinkTopic       =   "Form1"
   ScaleHeight     =   3975
   ScaleWidth      =   5070
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox lstResults 
      Height          =   2400
      Left            =   240
      TabIndex        =   4
      Top             =   1200
      Width           =   2175
   End
   Begin VB.CommandButton btnFind 
      Caption         =   "Search"
      Height          =   375
      Left            =   3360
      TabIndex        =   2
      Top             =   120
      Width           =   1575
   End
   Begin VB.TextBox txtSearchWord 
      Height          =   285
      Left            =   1200
      TabIndex        =   1
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label Label2 
      Caption         =   "Results:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   600
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "Search For:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private wordMap As Scripting.Dictionary

Private Sub Form_Load()
    'Create the dictionary which will contain the phonetic key->word map
    Set wordMap = New Scripting.Dictionary
    
    'Read the namelist file
    Dim oFile As Scripting.FileSystemObject
    Dim oStream As Scripting.TextStream
    Dim word As String
    Dim words As Variant
    Dim mphone As New MetaphoneCOM.DoubleMetaphoneString
    Dim primaryKey As String
    Dim alternateKey As String
    
    Set oFile = New Scripting.FileSystemObject
    Set oStream = oFile.OpenTextFile(oFile.BuildPath(App.Path, "..\namelist.txt"))
    
    While Not oStream.AtEndOfStream
        word = oStream.ReadLine
        mphone.ComputeMetaphoneKeys word, primaryKey, alternateKey
        
        'Add an entry to the dictionary for each key
        If Not wordMap.Exists(primaryKey) Then
            'No words associated with this key, so create an empty entry for it
            wordMap.Add primaryKey, Array()
        End If
        
        'Get the array of words for the key, then grow it by one and add
        'the word we just read
        words = wordMap.Item(primaryKey)
        ReDim Preserve words(UBound(words) + 1)
        words(UBound(words)) = word
        wordMap.Item(primaryKey) = words
        
        If Len(alternateKey) > 0 Then
            'Alternate key also computed
            If Not wordMap.Exists(alternateKey) Then
                'No words associated with this key, so create an empty entry for it
                wordMap.Add alternateKey, Array()
            End If
            
            'Get the array of words for the key, then grow it by one and add
            'the word we just read
            words = wordMap.Item(alternateKey)
            ReDim Preserve words(UBound(words) + 1)
            words(UBound(words)) = word
            wordMap.Item(alternateKey) = words
        End If
    Wend
    oStream.Close
End Sub

Private Sub btnFind_Click()
    'Perform the search
    Dim searchWord As String
    
    searchWord = Trim(Me.txtSearchWord.Text)
    If Len(searchWord) = 0 Then
        MsgBox "You must enter a search word"
        Exit Sub
    End If
    
    Me.lstResults.Clear
    
    'Compute the double metaphone keys for the search word
    Dim mphone As New MetaphoneCOM.DoubleMetaphoneString
    Dim primaryKey As String
    Dim alternateKey As String
    
    mphone.ComputeMetaphoneKeys searchWord, primaryKey, alternateKey
    
    'Search the dictionary
    Dim words
    Dim wordIdx As Integer
    Dim listIdx As Integer
    
    If wordMap.Exists(primaryKey) Then
        words = wordMap.Item(primaryKey)
        
        For wordIdx = 0 To UBound(words)
            Me.lstResults.AddItem words(wordIdx)
        Next
    End If
    
    If Len(alternateKey) > 0 Then
        'Also an alternate key.  Search with that
        If wordMap.Exists(alternateKey) Then
            words = wordMap.Item(alternateKey)
            
            For wordIdx = 0 To UBound(words)
                'If item isn't already in the list, add it
                For listIdx = 0 To Me.lstResults.ListCount
                    If Me.lstResults.List(listIdx) = words(wordIdx) Then GoTo NextWord
                Next
                
                Me.lstResults.AddItem words(wordIdx)
                
NextWord:
            Next
        End If
    End If
End Sub