36 lines
1.2 KiB
Text
36 lines
1.2 KiB
Text
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
|