Function getCode(c As String) As String
    If Instr("BFPV", c)     Then Return "1"
    If Instr("CGJKQSXZ", c) Then Return "2"
    If Instr("DT", c)       Then Return "3"
    If "L" = c              Then Return "4"
    If Instr("MN", c)       Then Return "5"
    If "R" = c              Then Return "6"
    If Instr("HW", c)       Then Return "."
End Function

Function Soundex(palabra As String) As String
    palabra = Ucase(palabra)
    Dim As String code = Mid(palabra,1,1)
    Dim As String previo = getCode(Left(palabra, 1)) ''""
    Dim As String actual

    For i As Byte = 2 To (Len(palabra) + 1)
        actual = getCode(Mid(palabra, i, 1))
        If actual = "." Then Continue For
        If Len(actual) > 0 And actual <> previo Then code &= actual
        previo = actual
        If Len(code) = 4 Then Exit For
    Next i
    If Len(code) < 4 Then code &= String(4,"0")
    Return Left(code,4)
End Function

Dim As String nombre
For i As Byte = 1 To 20
    Read nombre
    Print """"; nombre; """"; Tab(15); Soundex(nombre)
Next i

Data "Aschraft", "Ashcroft", "Euler", "Gauss", "Ghosh", "Hilbert", "Heilbronn", "Lee", "Lissajous", "Lloyd"
Data "Moses", "Pfister", "Robert", "Rupert", "Rubin", "Tymczak", "VanDeusen", "Wheaton", "Soundex", "Example"
Sleep