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

Option Explicit

dim wordMap

 'Create the dictionary which will contain the phonetic key->word map
 Set wordMap = CreateObject("Scripting.Dictionary")
 
 'Read the namelist file
 Dim oFile
 Dim oStream
 Dim word
 Dim words
 Dim mphone
 Dim primaryKey
 Dim alternateKey
 
 Set oFile = CreateObject("Scripting.FileSystemObject")
 Set oStream = oFile.OpenTextFile("..\namelist.txt")
 Set mphone = CreateObject("MetaphoneCOM.DoubleMetaphoneString")
 
 WScript.Echo "Loading name data; this will take several seconds..."
 
 While Not oStream.AtEndOfStream
     word = oStream.ReadLine
     mphone.ComputeMetaphoneKeysScr 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
 
 'Begin the search
dim searchWord
dim results
Dim wordIdx
Dim listIdx
dim resultsString

'Hack the dictionary object for use a a Set, which does not allow duplicate entries, to
'de-dupe the list of results
set results = CreateObject("Scripting.Dictionary")

while true
   searchWord = InputBox("Enter name to search for", "VBScript Word Lookup", "Nelson")
   if searchWord = "" then
      WScript.Quit()
   end if
   searchWord = Trim(searchWord)
   If Len(searchWord) = 0 Then
      MsgBox "You must enter a search word"
      WScript.Quit()
   End If
   
   mphone.ComputeMetaphoneKeysScr searchWord, primaryKey, alternateKey
   results.RemoveAll
   
   If wordMap.Exists(primaryKey) Then
      words = wordMap.Item(primaryKey)
      
      For wordIdx = 0 To UBound(words)
         Results(words(wordIdx)) = true
      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)
            Results(words(wordIdx)) = true
         Next
     End If
   End If
   
   'The Keys property of the results dictionary contains a list of unique words from
   'the results
   resultsString = "Found " & results.Count & " matches:" & vbCrLf
   
   for each word in results.Keys
      resultsString = resultsString & vbTab & word & vbCrLf
   next
   
   MsgBox resultsString, , "VBScript Word Lookup"
wend