Privacidad: Recuerde que la información escrita en los foros de programación es 100% pública y que su ip será registrada asociada a su mensaje. Si encuentra un mensaje fuera de lugar, por favor, notifiquelo para su revisión y eliminación.
Curp y rfc
Enviado por Miguel Angel el día 29 de enero de 2004
Disculpen ma molestia, pero esta a la puerta las informativas de sueldos y salarios, y quisiera saber si aguien de este foro, me pudiera facilitar algun programa, de antemano se los agradesco, y si no gracias de todos modos.
Enviado por edu1305 el día 27 de diciembre de 2004
estoy viendo que tu pediste algo que yo estoy solicitando y ocupando en estos momentos no se si lo pudiste conseguir y si de ser asi como lo hicistes gracias atte victo edu
La CURP solo la puedes sacar en la secretaria de gobernacion, IMSS y el Registro Civil, en internet lo unico que hacen es checar como esta integrada pero no estas registrado en gobernacion. Asi que no te confies de que en Internet la puedes sacar, si estas registrado si puedes bajar una copia pero nunca te registras por internet.
Les aviso que si el programa que genera el RFC no contempla todos los casos de escepción posiblemente algunos RFC´s no serán válidos, sólo les aviso, espero que les sirva mi comentario
'Option Compare Database
Option Base 1
Option Explicit
Private wPaterno As String, wMaterno As String, wNombre As String
Private Paterno As String, Materno As String, Nombre As String
Private wRFC As String, wNumer6 As String
Private Arre2, Arre6, Arre8, Arre9, Anex11, Anex12, anex21, anex22, anex31, anex32
Public Function genera_rfc(ByVal CL_PAT As String, ByVal CL_MAT As String, ByVal CL_NOM As String, ByVal DL_FecNac As Date)
Class_Initialize
Dim finice As Boolean
CL_PAT = UCase(CL_PAT)
CL_MAT = UCase(CL_MAT)
CL_NOM = UCase(CL_NOM)
wRFC = ""
wPaterno = CL_PAT
wMaterno = CL_MAT
wNombre = CL_NOM
Paterno = Trim(wPaterno)
Materno = Trim(wMaterno)
Nombre = Trim(wNombre)
' Convierte la fecha de nacimiento al formato AAMMDD
wNumer6 = Mid(Format(Year(DL_FecNac), "0000"), 3, 2) & Format(Month(DL_FecNac), "00") & Format(Day(DL_FecNac), "00")
' Verifica los nombres
If Not LOS3 Then
genera_rfc = ""
Exit Function
End If
finice = False
Paterno = Octava(Paterno)
Materno = Octava(Materno)
Nombre = Octava(Nombre)
Nombre = Sexta(Nombre)
Paterno = Tercera(Paterno)
Materno = Tercera(Materno)
Nombre = Tercera(Nombre)
If (Len(Paterno) = 0 Or Len(Materno) = 0) Then
SEPTIMA
finice = True
End If
If (Not finice) Then
If (Len(Paterno) < 3) Then
CUARTA
finice = True
End If
End If
If (Not finice) Then
prime_segu
End If
genera_rfc = Mid(wRFC, 1, 4) & Mid(wRFC, 5, 6)
'genera_rfc = Mid(wRFC, 1, 4) & "-" & Mid(wRFC, 5, 6) & "-" & Mid(wRFC, 11, 3)
End Function
Private Sub show_it()
Dim van As Long
van = ascan(Arre9, Mid(wRFC, 1, 4))
If (van > 0) Then
wRFC = Mid(wRFC, 1, 3) & "X" & Mid(wRFC, 5)
End If
homoni
Digito
End Sub
Private Sub prime_segu()
Dim Letra As String
Dim x As Long
Dim van As Long
Letra = Mid(Paterno, 2, 1)
For x = 2 To Len(Paterno)
van = ascan(Arre2, Mid(Paterno, x, 1))
If (van > 0) Then
Letra = Arre2(van)
x = Len(Paterno) + 8
End If
Next
wRFC = Mid(Paterno, 1, 1) + Letra + Mid(Materno, 1, 1) + Mid(Nombre, 1, 1)
wRFC = wRFC + wNumer6 + "000"
show_it
End Sub
Private Function Tercera(ByRef vNombre As String) As String
If (Mid(vNombre, 1, 2) = "CH") Then
vNombre = Replace(vNombre, "CH", "C", 1, 1)
Else
If (Mid(Nombre, 1, 2) = "LL") Then
vNombre = Replace(vNombre, "LL", "L", 1, 1)
End If
End If
Tercera = vNombre
End Function
Private Sub CUARTA()
wRFC = Mid(Paterno, 1, 1) + Mid(Materno, 1, 1) + Mid(Nombre, 1, 2) + wNumer6 + "000"
show_it
End Sub
Private Function Sexta(ByVal vNombre As String) As String
Dim xx As Long
If (InStr(1, vNombre, " ") > 0) Then
For xx = 1 To UBound(Arre6)
vNombre = Replace(vNombre, Arre6(xx), "")
Next
End If
Sexta = vNombre
End Function
Private Sub SEPTIMA()
Dim UnoSolo As String
If (Len(Paterno) = 0 And Len(Materno) > 0) Then
UnoSolo = Materno
Else
If (Len(Paterno) > 0 And Len(Materno) = 0) Then
UnoSolo = Paterno
Else
UnoSolo = Nombre
End If
End If
wRFC = Mid(UnoSolo, 1, 2) + Mid(Nombre, 1, 2) + wNumer6 + "000"
show_it
End Sub
Private Function Octava(ByVal vNombre As String) As String
Dim i As Long
For i = 1 To UBound(Arre8)
vNombre = Replace(vNombre, Arre8(i), "")
Next
Octava = vNombre
End Function
Private Function LOS3()
Dim wLos3 As String
wLos3 = Trim(Paterno & " " & Materno & " " & Nombre)
While InStr(1, wLos3, " ")
wLos3 = Replace(wLos3, " ", " ")
Wend
If (Len(wLos3) <= 6) Then
LOS3 = False
Else
LOS3 = True
End If
End Function
'HOMONIMO DEL RFC ......
Private Sub homoni()
Dim unok As String
Dim wBase As String
Dim Valores As String
Dim sumas As Long
Dim SoloTres As Long
Dim Cociente As Long
Dim Residuo As Long
Dim van As Long
Dim x As Long
Dim Homo As String
Valores = "0"
wBase = Trim(Trim(wPaterno) & " " & Trim(wMaterno) & " " & Trim(wNombre))
For x = 1 To Len(wBase)
unok = Mid(wBase, x, 1)
van = ascan(Anex11, IIf(unok = " ", "*", unok))
If (van > 0) Then
Valores = Valores + Anex12(van)
Else
Valores = Valores + "00"
End If
Next
sumas = 0
For x = 1 To Len(Valores) - 1
sumas = sumas + (Val(Mid(Valores, x, 2)) * Val(Mid(Valores, x + 1, 1)))
Next
SoloTres = Val(Right(Format(sumas, " 0"), 3))
Cociente = Int(SoloTres / 34)
Residuo = SoloTres - Cociente * 34
van = ascan(anex21, Format(Cociente, "00"))
If (van > 0) Then
Homo = anex22(van)
Else
Homo = "1"
End If
van = ascan(anex21, Format(Residuo, "00"))
If (van > 0) Then
Homo = Homo + anex22(van)
Else
Homo = Homo + "1"
End If
wRFC = Mid(wRFC, 1, 10) + Homo
End Sub
'DIGITO VERIFICADOR DEL RFC ...
Private Sub Digito()
Dim Valores As String
Dim i As Integer
Dim unok As String
Dim x As Long
Dim sumas As Long
Dim van As Long
Dim Residuo As Long
Dim Valor As Long
Dim Digito As String
Valores = ""
For x = 1 To Len(wRFC)
unok = Mid(wRFC, x, 1)
van = ascan(anex31, IIf(unok = " ", "*", unok))
If van > 0 Then
Valores = Valores + anex32(van)
Else
Valores = Valores + "00"
End If
Next
sumas = 0
For x = 1 To 12
sumas = sumas + Val(Mid(Valores, x * 2 - 1, 2)) * (14 - x)
Next
Residuo = Int(sumas) - Int(sumas / 11) * 11
If Residuo = 0 Then
Digito = "0"
Else
Valor = 11 - Residuo
If (Valor = 10) Then
Digito = "A"
Else
Digito = Right(CStr(Valor), 1)
End If
End If
wRFC = wRFC + Digito
End Sub
' Busca un valor en una matriz, si lo encuentra regresa el índice, si no lo encuentra regresa 0
Public Function ascan(vMatriz, vValor As String) As Long
Dim i As Long
Dim vStop As Boolean
vStop = False
For i = 1 To UBound(vMatriz) And Not vStop
If vMatriz(i) = vValor Then
vStop = True
Exit For
End If
Next
ascan = IIf(vStop, i, 0)
End Function
' Inicializa la clase
Private Sub Class_Initialize()
Arre2 = Array("A", "E", "I", "O", "U")
Function DameConsonantes(APaterno As String, AMaterno As String, Nombres As String)
Const vocal = "AEIOU"
Dim consonantes As String
Dim i As Integer
consonantes = ""
If Len(APaterno) > 2 And Len(Replace(AMaterno, " ", "")) > 2 Then
' Busca la primer consonante del apellido paterno
For i = 2 To Len(APaterno)
If InStr(1, vocal, Mid(APaterno, i, 1)) = 0 Then
consonantes = Mid(APaterno, i, 1)
Exit For
End If
Next
' Busca la primer consonante del apellido materno
For i = 2 To Len(AMaterno)
If InStr(1, vocal, Mid(AMaterno, i, 1)) = 0 Then
consonantes = consonantes & Mid(AMaterno, i, 1)
Exit For
End If
Next
For i = 2 To Len(Nombres)
If InStr(1, vocal, Mid(Nombres, i, 1)) = 0 Then
consonantes = consonantes & Mid(Nombres, i, 1)
Exit For
End If
Next
End If
DameConsonantes = Replace(consonantes, "Ñ", "X")
End Function
'GENERA CURP ...........
Function genera_curp(APaterno As String, AMaterno As String, _
Nombres As String, Fecha As Date, _
Sexo As String, LNacimiento As String)
Dim CURP As String
Dim PRIMERA As String
Dim consonantes As String
Dim DIGITO1 As String
Dim DIGITO2 As String
Dim RFC As String
Dim vEstados
Dim vClaveCURP As String
Dim vSexo As String
If Len(APaterno) = 0 And Len(AMaterno) = 0 Then
genera_curp = " SIN APELLIDOS "
Exit Function
Else
If Len(Nombres) = 0 Then
genera_curp = " SIN NOMBRE "
Exit Function
Else
If Len(Nombres) = 0 Then
genera_curp = " SIN NOMBRE "
Exit Function
Else
If IsNull(Fecha) Then
genera_curp = " SIN FECHA "
Exit Function
End If
End If
End If
End If
RFC = genera_rfc(APaterno, AMaterno, Nombres, Fecha)
If Year(Fecha) < 2000 Then
DIGITO1 = "0"
Else
DIGITO1 = "A"
End If
'Set vEstados = CurrentDb.OpenRecordset("SELECT * FROM Estados WHERE Edo = '" & LNacimiento & "'")
'Set vEstados = CurrentDb.OpenRecordset("SELECT * FROM Estados WHERE Estado = '" & LNacimiento & "'")
If vEstados.EOF Then
vClaveCURP = "NE"
Else
vClaveCURP = vEstados("ClaveCURP").Value
End If
' El sexo es H Hombre, M Mujer
Select Case Sexo
Case "0", "H", "h":
vSexo = "H"
Case "1", "M", "m":
vSexo = "M"
Case Else
vSexo = "H"
End Select
CURP = Mid(RFC, 1, 11) & "-" & vSexo & vClaveCURP & _
DameConsonantes(Paterno, Materno, Nombre) & DIGITO1 & _
Mid(RFC, 15, 1)
genera_curp = UCase(CURP)
End Function
Disculpa este codigo como lo puedo usar ya que soy principiante en visual basic y en la escuela de examen final nos pidieron un programa que calcule el rfc y curp elaborado en cualquier lenguaje y supongo yo en visual es mas facil si me pudieras ayudar te lo agradeceria mucho.
he logrado calcular el RFC con Homoclave y digito verificador, tambien la CURP pero NO logro calcular el digito verificador, lo estoy desarrollando para Visual Basic,
¿como logras calcular el digito verificador solamente para la CURP?
este es el ultimo digito que me hace falta para completar mi codigo.
Hola chica me gustarian esos progra,mas y me gustaria saber en que lenguajelos isistes :) esque soy un fanatico a la programacion y a demas que ocupo mi curp
Hola Lupita, supe que tu tienes un programa para sacar la CURP, no sabes cuanto me urge, podria hasta perder mi trabajo por esos tramites, te agradeceria muchisimo que me enviaras ese programa. Te agradezco de antemano y porfavor, espero tu correo!
Hola... me tome el atrevimiento de enviarte este mail para ver si es posible que puedas enviarme los dos "programitas" para calcular CURP y RFC en Visual Basic. Soy estudiante de Informática y estamos analizando codificación y operaciones de variables en V.B., la cosa es que necesitamos esos programas porque el maestro nos los pidió pero no tengo ni idea de como hacer eso ya que apenas vamos empezando a hacer leves programas.
Espero que puedas ayudarme, de antemano, gracias.
Norberto
HOLA QUE TAL...POR FAVOR AYUDENME...NECESITO UN PROGRAMA QUE CALCULE EL RFC Y CURP....SI ALGUIEN LO TIENE ME LO PODRIAN MANDAR A MI CORREO anix182@hotmail.com ME URGE....
Foros de debate
Visual Basic
