Public Function soundexesp(input As String) As String
Dim soundexvar As String = String.Empty
Dim inputForFunctions As String
'-- para determinar la primera letra
Dim pri_letra As String
Dim resto As String
Dim sustituida As String
'-- para quitar adyacentes
Dim anterior As String
Dim actual As String
Dim corregido As String
Try
If input.Trim = String.Empty Then
Throw New Exception("cadena no puede estar vacia")
End If
corregido = String.Empty
sustituida = String.Empty
'-- 1: LIMPIEZA:
'-- pasar a mayuscula, eliminar la letra "H" inicial, los acentos y la enie
'-- 'holá coñó' => 'OLA CONO'
inputForFunctions = input.Trim.ToUpper
inputForFunctions = inputForFunctions.Replace("H", "")
inputForFunctions = ConvertToUnicode(inputForFunctions)
''-- eliminar caracteres no alfabéticos (números, símbolos como &,%,",*,!,+, etc.
input = System.Text.RegularExpressions.Regex.Replace(inputForFunctions, "[^0-9a-zA-Z]+", "")
'-- 2: PRIMERA LETRA ES IMPORTANTE, DEBO ASOCIAR LAS SIMILARES
'-- 'vaca' se convierte en 'baca' y 'zapote' se convierte en 'sapote'
'-- un fenomeno importante es GE y GI se vuelven JE y JI; CA se vuelve KA, etc
pri_letra = input.Substring(0, 1)
resto = input.Substring(1, input.Length - 1)
Select Case pri_letra
Case "V"
sustituida = "B"
Case "Z", "X"
sustituida = "S"
Case "G"
If input.Substring(1, 1).Contains("E") Or
input.Substring(1, 1).Contains("I") Then
sustituida = "J"
End If
Case "C"
Select Case input.Substring(1, 1)
Case "H", "E", "I"
Case Else
sustituida = "K"
End Select
Case Else
sustituida = pri_letra
End Select
'-- corregir el parametro con las consonantes sustituidas:
input = sustituida & resto
'-- 3: corregir "letras compuestas" y volverlas una sola
input = input.Replace("CH", "V")
input = input.Replace("QU", "K")
input = input.Replace("LL", "J")
input = input.Replace("CE", "S")
input = input.Replace("CI", "S")
input = input.Replace("YA", "J")
input = input.Replace("YE", "J")
input = input.Replace("YI", "J")
input = input.Replace("YO", "J")
input = input.Replace("YU", "J")
input = input.Replace("GE", "J")
input = input.Replace("GI", "J")
input = input.Replace("NY", "N")
'-- EMPIEZA EL CALCULO DEL SOUNDEX
'-- 4: OBTENER PRIMERA letra
pri_letra = input.Substring(0, 1)
'-- 5: retener el resto del string
resto = input.Substring(1, input.Length - 1)
'--6: en el resto del string, quitar vocales y vocales fonéticas
For Each l As String In "AEIOUHWY"
resto = resto.Replace(l, "")
Next
'--7: convertir las letras foneticamente equivalentes a
'--numeros(esto hace que B sea equivalente a V, C con S y Z, etc.)
Dim indexNum1 As Integer = 0
Dim indexNum2 As Integer = 0
For Each l As String In "BPFVCGKSXZDTLMNRQJ"
indexNum1 += 1
For Each s As String In "111122222233455677"
indexNum2 += 1
If indexNum1 = indexNum2 Then
resto = resto.Replace(l, s)
indexNum2 = 0
Exit For
End If
Next
Next
'-- así va quedando la cosa
soundexvar = pri_letra & resto
'--8: eliminar números iguales adyacentes (A11233 se vuelve A123)
anterior = soundexvar.Substring(0, 1)
corregido = anterior
Dim i As Integer = 1
Dim checkLen As Integer = soundexvar.Length
Do While i < checkLen
actual = soundexvar.Substring(i, 1)
If actual <> anterior Then
corregido = corregido & actual
anterior = actual
End If
i += 1
Loop
'-- así va la cosa
soundexvar = corregido
'-- 9: siempre retornar un string de 4 posiciones
soundexvar = soundexvar.PadRight(4, "0")
soundexvar = soundexvar.Substring(0, 4)
'-- YA ESTUVO
Catch ex As Exception
Throw ex
End Try
Return soundexvar
End Function
Private Function ConvertToUnicode(strRequest As String) As String
Dim strResult As String = String.Empty
Try
If strRequest <> String.Empty Then
strResult = strRequest.Replace("Á", "A")
strResult = strResult.Replace("É", "E")
strResult = strResult.Replace("Í", "I")
strResult = strResult.Replace("Ó", "O")
strResult = strResult.Replace("Ú", "U")
strResult = strResult.Replace("À", "A")
strResult = strResult.Replace("È", "E")
strResult = strResult.Replace("Ì", "I")
strResult = strResult.Replace("Ò", "O")
strResult = strResult.Replace("Ù", "U")
strResult = strResult.Replace("Ñ", "N")
strResult = strResult.Replace("ñ", "n")
End If
Catch ex As Exception
End Try
Return strResult
End Function
Por favor usar esta versión en la que corrijo un error en la función.
Saludos.