Sub SoundexEncode(word As String)
Dim UsedLetters() As String = Array As String("B", "F", "P", "V","C","G", "J", "K", "Q", "S", "X", "Z","D", "T","L","M","N","R")
Dim UC As Map
UC.Initialize
For i=0 To UsedLetters.Length-1
If i<4 Then
UC.Put(UsedLetters(i),1)
End If
If i>=4 And i<12 Then
UC.Put(UsedLetters(i),2)
End If
If i>=12 And i<14 Then
UC.Put(UsedLetters(i),3)
End If
If i=14 Then
UC.Put(UsedLetters(i),4)
End If
If i>14 And i<17 Then
UC.Put(UsedLetters(i),5)
End If
If i=17 Then
UC.Put(UsedLetters(i),6)
End If
Next
Dim Letter,Replacement As String
Dim SoundexWord As String
word=word.ToUpperCase
For i=0 To word.Length -1
Letter=word.SubString2(i,i+1)
If UC.ContainsKey(Letter) Then
If SoundexWord.Length=0 Then
'first letter
SoundexWord=SoundexWord&Letter
Else
Replacement=UC.Get(Letter)
If SoundexWord.SubString2(SoundexWord.Length-1,SoundexWord.Length)<>Replacement Then
SoundexWord=SoundexWord&UC.Get(word.SubString2(i,i+1))
End If
End If
End If
If SoundexWord.Length=4 Then Exit
Next
Do While SoundexWord.Length<4
SoundexWord=SoundexWord&"0"
Loop
Log("Soundex encoded: " & SoundexWord)
End Sub