Buen dia, aqui les dejo una pequeña funcion para calcular el RFC por si a alguien le sirve... trabajando en la de la CURP, Saludos
Primera Parte:
Friend Function Calcula_RFC(ByVal Nombres As String, ByVal APaterno As String, ByVal AMaterno As String, ByVal FNacimiento As Date) As String
'--------------------------------------------------------------------------------------------------
'Algoritmo para el calculo del RFC, by: Edgar Uranda Estrada 18/11/2009 --------------------------
'--------------------------------------------------------------------------------------------------
Dim NombresNulos As String = "JOSE,MARIA,MA.,MA,DE,LA,LAS,MC,VON,DEL,LOS,Y, MAC, VAN"
'--------------------------------------------------------------------------------------------------
'Quitando caracteres especiales
Dim ExpresionRegular As RegularExpressions.Regex = New RegularExpressions.Regex("[^a-zA-Z0-9 ]")
Dim StringNormalizada As String
'Nombres sin caracteres
StringNormalizada = Nombres.Normalize(NormalizationForm.FormD)
Nombres = ExpresionRegular.Replace(StringNormalizada, "")
'Apellido Paterno sin caracteres
If APaterno <> "" Then
StringNormalizada = APaterno.Normalize(NormalizationForm.FormD)
APaterno = ExpresionRegular.Replace(StringNormalizada, "")
End If
'Apellido Materno sin caracteres
If AMaterno <> "" Then
StringNormalizada = AMaterno.Normalize(NormalizationForm.FormD)
AMaterno = ExpresionRegular.Replace(StringNormalizada, "")
End If
'-------------------------------------------------------------------------------------------------
Dim RFC As String
'Procesando Nombres y quitando nulos
Dim ArrayNombres() As String = Split(Nombres)
Dim Nombre As String
For Each NombreValida As String In ArrayNombres
If InStr(NombresNulos, NombreValida, CompareMethod.Text) = 0 And ArrayNombres.Count > 1 Then
Nombre = NombreValida
Exit For
Else
Nombre = NombreValida
End If
Next
'ASIGNANDO LETRAS
'------------------------------------------------------------------------------------------------------------
Dim Primeraletra As String
Dim SegundaLetra As String
Dim TerceraLetra As String
Dim CuartaLetra As String
Dim ApellidoPat As String
Dim ApellidoMat As String
If APaterno <> "" And AMaterno <> "" Then 'En el Caso de que tenga los dos Apelldios
'Procesando Apellido Paterno
Dim ArrayApellidoPat() As String = Split(APaterno)
For Each ApellidoPatValida As String In ArrayApellidoPat
If InStr(NombresNulos, ApellidoPatValida, CompareMethod.Text) = 0 And ArrayApellidoPat.Count > 1 Then
ApellidoPat = ApellidoPatValida
Exit For
Else
ApellidoPat = ApellidoPatValida
End If
Next
Primeraletra = Mid(ApellidoPat, 1, 1)
'Procesando Apellido Materno
Dim ArrayApellidoMat() As String = Split(AMaterno)
For Each ApellidoMatValida As String In ArrayApellidoMat
If InStr(NombresNulos, ApellidoMatValida, CompareMethod.Text) = 0 And ArrayApellidoMat.Count > 1 Then
ApellidoMat = ApellidoMatValida
Exit For
Else
ApellidoMat = ApellidoMatValida
End If
Next
'Extrayendo la primera letra del Apellido Paterno y la primera vocal(si aplica)
Dim StrVocales As String = "A,E,I,O,U"
Primeraletra = Mid(ApellidoPat, 1, 1)
If Len(ApellidoPat) > 2 Then 'En el Caso que el Apellido Paterno sea Mayor de dos letras
'Procesando Vocal
For i = 2 To Len(ApellidoPat)
If InStr(StrVocales, Mid(ApellidoPat, i, 1), CompareMethod.Text) > 0 Then
SegundaLetra = Mid(ApellidoPat, i, 1)
Exit For
End If
Next
TerceraLetra = Mid(ApellidoMat, 1, 1)
CuartaLetra = Mid(Nombre, 1, 1)
Else
'Aplicando Regla "En los casos en que el apellido paterno de la persona física se componga
'de una o dos letras, la clave se formará de la siguiente manera:
'1. La primera letra del apellido paterno.
'2. La primera letra del apellido materno.
'3. La primera y segunda letra del nombre."
SegundaLetra = Mid(ApellidoMat, 1, 1)
TerceraLetra = Mid(Nombre, 1, 1)
CuartaLetra = Mid(Nombre, 2, 1)
End If
Else '-> En el caso de que no cuente con alguno de los dos Apellidos
'Aplicando Regla "En los casos en que la persona física tenga un solo apellido, se conformará
'con la primera y segunda letras del apellido paterno o materno, según figure en el acta de nacimiento,
'más la primera y segunda letras del nombre
If APaterno = "" Then
Dim ArrayApellidoMat() As String = Split(AMaterno)
For Each ApellidoMatValida As String In ArrayApellidoMat
If InStr(NombresNulos, ApellidoMatValida, CompareMethod.Text) = 0 And ArrayApellidoMat.Count > 1 Then
ApellidoMat = ApellidoMatValida
Exit For
Else
ApellidoMat = ApellidoMatValida
End If
Next
Primeraletra = Mid(ApellidoMat, 1, 1)
SegundaLetra = Mid(ApellidoMat, 2, 1)
Else
Dim ArrayApellidoPat() As String = Split(APaterno)
For Each ApellidoPatValida As String In ArrayApellidoPat
If InStr(NombresNulos, ApellidoPatValida, CompareMethod.Text) = 0 And ArrayApellidoPat.Count > 1 Then
ApellidoPat = ApellidoPatValida
Exit For
Else
ApellidoPat = ApellidoPatValida
End If
Next
Primeraletra = Mid(ApellidoPat, 1, 1)
SegundaLetra = Mid(ApellidoPat, 2, 1)
End If
TerceraLetra = Mid(Nombre, 1, 1)
CuartaLetra = Mid(Nombre, 2, 1)
End If
