Homoclave RFC
Considerando el volumen de empleados que
necesitan calcular RFC's y homoclaves, no creo
que te los den donde dices, tal vez 5 o 10 y no
es rápido. Tiene razón PALAFOX.
Yo estoy ofreciendo mi programa que permite
calcular en forma masiva todos los RFC's con
homoclaves de cualquier año.
Considerando el tiempo invertido en descifrar
y obtener el algoritmo, me parece justo ofrecerlo
por 50 Dlls. Además permite exportar el resultado
a algunos sistemas de nomina, Excel y ASCII.
Tambien ofrezco la funcion para quienes programan
en DLL.
Si alguien se interesa, puede escribirme a
[email protected]
Israel Vega Alvarez
necesitan calcular RFC's y homoclaves, no creo
que te los den donde dices, tal vez 5 o 10 y no
es rápido. Tiene razón PALAFOX.
Yo estoy ofreciendo mi programa que permite
calcular en forma masiva todos los RFC's con
homoclaves de cualquier año.
Considerando el tiempo invertido en descifrar
y obtener el algoritmo, me parece justo ofrecerlo
por 50 Dlls. Además permite exportar el resultado
a algunos sistemas de nomina, Excel y ASCII.
Tambien ofrezco la funcion para quienes programan
en DLL.
Si alguien se interesa, puede escribirme a
[email protected]
Israel Vega Alvarez
Buenas tardes al igual que usted me encuentro buscando tambien la homoclave, sin embargo al momento no he podido encontrarla, por lo que me permito preguntarle a usted si ya pudo encontrarla o bien donde puedo conseguir el algoritmo de como calcularla
Error su correo es:
[email protected]
[email protected]
PARA EL QUE LO SOLICITE EN ESTA PAGINA ENCONTRAN UN PROGRAMA MUY UTIL PARA DETERMINAR LA HOMOCLAVE http://aplicarh.tripod.com.mx/
SI NO LES FUNSIONA ME AVISAN PARA PASARLES UN ARCHIVO QUE A LO MEJOR ALGUNAS PC NO TIENEN OK....BYE
SI NO LES FUNSIONA ME AVISAN PARA PASARLES UN ARCHIVO QUE A LO MEJOR ALGUNAS PC NO TIENEN OK....BYE
Roberto: imagino que el archivo al que te refieres es MSCOMCT2.OCX, si es el caso, por favor envíamelo o indícame como conseguirlo.
Gracias.
Gracias.
porfavor necesito que me envies el archivo, porque no pude abrir el programa del link que pusiste y te agradeceria muchisimo que me lo mandes
me puedes decir donde encuentro el archivo o me lo puedes pasar para correr programa RFC y CURP.
Gracias
Gracias
Que tal Roberto baje el programa lo ejecute pero me pide un ocx me parece que es el archivo que me falta podrias mandarmelo por favor
La HOMOCLAVE se puede solictar en el modulo de atencion del Centro de Atencion de Consulta ubicado en Avenida Hidalgo
Considerando el volumen de empleados que
necesitan calcular RFC's y homoclaves, no creo
que te los den donde dices, tal vez 5 o 10 y no
es rápido. Tiene razón PALAFOX.
Yo estoy ofreciendo mi programa que permite
calcular en forma masiva todos los RFC's con
homoclaves de cualquier año.
Considerando el tiempo invertido en descifrar
y obtener el algoritmo, me parece justo ofrecerlo
por 50 Dlls. Además permite exportar el resultado
a algunos sistemas de nomina, Excel y ASCII.
Tambien ofrezco la funcion para quienes programan
en DLL.
Si alguien se interesa, puede escribirme a
[email protected]
Israel Vega Alvarez
necesitan calcular RFC's y homoclaves, no creo
que te los den donde dices, tal vez 5 o 10 y no
es rápido. Tiene razón PALAFOX.
Yo estoy ofreciendo mi programa que permite
calcular en forma masiva todos los RFC's con
homoclaves de cualquier año.
Considerando el tiempo invertido en descifrar
y obtener el algoritmo, me parece justo ofrecerlo
por 50 Dlls. Además permite exportar el resultado
a algunos sistemas de nomina, Excel y ASCII.
Tambien ofrezco la funcion para quienes programan
en DLL.
Si alguien se interesa, puede escribirme a
[email protected]
Israel Vega Alvarez
Crees que me la proporcionen de 2000 empleados....y yo estoy en BC norte....?
oye nesesito que me evies una copia de como sacar la homoclave rfc porfavor y al rato nos ponemos a mano con software que yo pueda tener o que te interse algo en espesial
PARA PODER SACAR SUS PROPIOS CALCULOS DE RFC Y CURP, TENDRAN QUE BAJAR ESTOS TRES ARCHIVOS Y COLOCARLOS EN LA MISMA CARPETA EN DONDE USTEDES ELIJAN ejem: "Mis Documentos", y de ahi podran ejecutar los programas y obtener sus RFC y CURP.
SALUDOS Y ESPERO QUE LES SIRVA.
http://aplicarh.tripod.com.mx/Descargas/CalcRFC.exe
http://aplicarh.tripod.com.mx/Descargas/CalcCURP.exe
http://www.demo.ascentive.com/support/new/images/lib/MSCOMCT2.OCX
SALUDOS Y ESPERO QUE LES SIRVA.
http://aplicarh.tripod.com.mx/Descargas/CalcRFC.exe
http://aplicarh.tripod.com.mx/Descargas/CalcCURP.exe
http://www.demo.ascentive.com/support/new/images/lib/MSCOMCT2.OCX
SE ME OLVIDO DECIRLES QUE PARA BAJAR LOS ARCHIVOS LE DEN CON UN CLICK DERECHO DEL MOUSE Y SELECCIONEN "GUARDAR DESTINO COMO" Y SELECCIONAN LA CARPETA DONDE QUIERAN GUARDARLOS.
NOTA: EL 3ER ARCHIVO ES NECESARIO PARA QUE LOS PROGRAMAS PUEDAN FUNCIONAR, DEBEN DE ESTAR EN LA MISMA CARPTA LOS 3 ARCHIVOS.
SALUDOS Y SUERTE.
NOTA: EL 3ER ARCHIVO ES NECESARIO PARA QUE LOS PROGRAMAS PUEDAN FUNCIONAR, DEBEN DE ESTAR EN LA MISMA CARPTA LOS 3 ARCHIVOS.
SALUDOS Y SUERTE.
necesito el programa para sacar el curp urgente, en escuinapa sin,
atentamente. h.ayuntamiento de escuinapa sin.
atentamente. h.ayuntamiento de escuinapa sin.
Solo te pueden proporcionar un programa que calcule los primeros 16 digitos y si acaso el digito verificador, el digito 17 del curp es para los duplicados, es decir, para que un programa te diga correctamente el curp (los 18 digitos) se tendria que enlazar con la base de datos de la renapo.
Cuidado con falsas promesas...
Saludos a Todos!!
Cuidado con falsas promesas...
Saludos a Todos!!
quisiera obtener mi registro federal del contribuyente y mi homoclave
quisiera obtener mi registro federal del contribuyente y mi homoclave
Pues me pasaron un exe que te genera homoclave
si hay interes se los puedo enviar y espero y les sirva de algo esta en compilado de clipper
si hay interes se los puedo enviar y espero y les sirva de algo esta en compilado de clipper
les paso el codigo para generar Rfc y Homoclave con digito Verificador que esta hecho en visual fox pro, les comento que tome el codigo que esta en este foro y no me funciono ya que la homoclave y el digito verificador no coincidian y pues de lo contrario les mando este codigo que ya esta validado y es funcional.
CODIGO DESARROLLADO EN VISUAL FOX PRO PARA GENERAR RFC CON HOMOCLAVE Y DIGITO VERIFICADOR SEGUN HACIENDA EN MEXICO
FUNCTION GENERA_RFC(CL_PAT,CL_MAT,CL_NOM,DL_FECNAC)
DIMENSION arre8(10),arre6(4),arre2(10),arre9(1),anex11(1),anex12(1),anex31(1),anex32(1)
arre8[1]="DE "
arre8[2]="DEL "
arre8[3]="LA "
arre8[4]="LOS "
arre8[5]="LAS "
arre8[6]="Y "
arre8[7]="MC "
arre8[8]="MAC "
arre8[9]="VON "
arre8[10]="VAN "
arre6[1]="JOSE "
arre6[2]="MARIA "
arre6[3]="J "
arre6[4]="MA "
arre2[1]="A"
arre2[2]="E"
arre2[3]="I"
arre2[4]="O"
arre2[5]="U"
arre2[6]="a"
arre2[7]="e"
arre2[8]="i"
arre2[9]="o"
arre2[10]="u"
arre9[1]=""
sino = "S"
malas ="BUEIBUEYCACACACOCAGACAGOCAKACAKOCOGECOJAKOGEKOJOKAKAKULOMAMEMAMO"
malas = malas +"MEARMEASMEONMIONCOJECOJICOJOCULOFETOGUEYJOTOKACAKACOKAGA"
malas = malas + "KAGOMOCOMULAPEDAPEDOPENEPUTAPUTOQULORATARUIN"
for x = 1 to Len(malas) step 4
DIMENSION arre9(X)
arre9(X)=SubStr(malas, x, 4)
next
anex11[1] = ''
anex12[1] = ''
taba11 = "*0123456789&ABCDEFGHIJKLMNOPQRSTUVWXYZ"
taba12 = "000001020304050607080910101112131415161718192122232425262728293233343536373839"
for x = 1 to Len(taba11)
DIMENSION anex11(x),anex12(x)
anex11(x)=SubStr(taba11, x, 1)
two = x * 2 - 1
anex12(x)=SubStr(taba12, two, 2)
next
malas = ""
taba11 = ""
taba12 = ""
taba21 = "00010203040506070809101112131415161718192021222324252627282930313233"
taba22 = "123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
for x = 1 to Len(taba21) step 2
DIMENSION anex21(x),anex22(x)
anex21(x)=SubStr(taba21, x, 2)
two = ( x + 1 ) / 2
anex22(x)=SubStr(taba22, two, 1)
next
taba21 = ""
taba22 = ""
taba11 = "0123456789ABCDEFGHIJKLMN&OPQRSTUVWXYZ*"
taba12 = "0001020304050607080910111213141516171819202122232425262728293031323334353637"
anex31(1) = ''
anex32(1) = ''
FOR x = 1 to Len(taba11)
DIMENSION anex31(x),anex32(x)
anex31(x)=SubStr(taba11, x, 1)
two = (x * 2) - 1
anex32(x)=SubStr(taba12, two, 2)
NEXT
STORE SPACE(0) TO taba11,taba12,wrfc,wnumer6,wlos3
STORE Space(30) TO wpaterno,wmaterno,wnombre,paterno,materno,nombre
mask = Replicate("!", 30)
wanual = VAL(STR(YEAR(dl_fecnac),4)+PADL(ALLTRIM(STR(MONTH(dl_Fecnac),2)),2,'0')+PADL(ALLTRIM(STR(DAY(dl_fecnac),2)),2,'0'))
wpaterno = CL_PAT
wmaterno = CL_MAT
wnombre = CL_NOM
IF nacio(wanual) = .F.
=MESSAGEBOX('La Fecha de Nacimiento es Incorrecta',16+0,'Error')
RETURN SPACE(0)
ENDIF
IF los3(wpaterno, wmaterno, wnombre) = .F.
=MESSAGEBOX('El Nombre del Empleado es Incorrecto',16+0,'Error')
RETURN SPACE(0)
ENDIF
finice = .F.
octava()
sexta()
tercera()
wbase = alltrim(alltrim(paterno) + " " + alltrim(materno) +" " + alltrim(nombre))
IF ( Len(paterno) = 0 .OR. Len(materno) = 0 )
septima()
finice = .T.
ENDIF
IF ( !finice )
IF ( Len(paterno) < 3 )
cuarta()
finice = .T.
ENDIF
ENDIF
IF ( !finice )
prime_segu()
ENDIF
RETURN wrfc
ENDFUNC
PROCEDURE SHOW_IT( Arg1 )
cuatro = SubStr(Arg1, 1, 4)
van = ascan(arre9, cuatro)
if ( van > 0 )
wrfc = stuff(wrfc, 4, 1, "X")
endif
homoni()
digito()
RETURN
ENDPROC
PROCEDURE PRIME_SEGU()
letra = SubStr(paterno, 2, 1)
for x = 2 to Len(paterno)
van = ascan(arre2, SubStr(paterno, x, 1))
if ( van > 0 )
letra = arre2[ van ]
x = Len(paterno) + 8
endif
next
wrfc = SubStr(paterno, 1, 1) + letra + SubStr(materno, 1, 1) + SubStr(nombre, 1, 1)
wrfc = wrfc + wnumer6 + "000"
show_it(wrfc)
RETURN
ENDPROC
PROCEDURE TERCERA()
IF ( SubStr(nombre, 1, 2) = "CH" )
nombre = stuff(nombre, 1, 2, "C")
ELSE
IF ( SubStr(nombre, 1, 2) = "LL" )
nombre = stuff(nombre, 1, 2, "L")
ENDIF
ENDIF
IF ( SubStr(paterno, 1, 2) = "CH" )
paterno = stuff(paterno, 1, 2, "C")
ELSE
IF ( SubStr(paterno, 1, 2) = "LL" )
paterno = stuff(paterno, 1, 2, "L")
ENDIF
ENDIF
IF ( SubStr(materno, 1, 2) = "CH" )
materno = stuff(materno, 1, 2, "C")
ELSE
IF ( SubStr(materno, 1, 2) = "LL" )
materno = stuff(materno, 1, 2, "L")
ENDIF
ENDIF
RETURN
ENDPROC
********************************
PROCEDURE CUARTA()
wrfc = SubStr(paterno, 1, 1) + SubStr(materno, 1, 1) +SubStr(nombre, 1, 2) + wnumer6 + "000"
show_it(wrfc)
RETURN
ENDPROC
********************************
PROCEDURE SEXTA()
posi = At(" ", nombre)
IF ( posi > 0 )
FOR xx = 1 to ALen(arre6,1)
nombre = strtran(nombre, arre6[xx])
NEXT
ENDIF
RETURN
ENDPROC
********************************
PROCEDURE SEPTIMA()
IF ( Len(paterno) = 0 .AND. Len(materno) > 0 )
unosolo = materno
ELSE
IF ( Len(paterno) > 0 .AND. Len(materno) = 0 )
unosolo = paterno
ENDIF
ELSE
unosolo = nombre
endif
wrfc = SubStr(unosolo, 1, 2) + SubStr(nombre, 1, 2) + wnumer6 + "000"
show_it(wrfc)
RETURN
ENDPROC
********************************
PROCEDURE OCTAVA()
FOR xx = 1 to aLen(arre8,1)
paterno = strtran(paterno, arre8[ xx ])
materno = strtran(materno, arre8[ xx ])
nombre = strtran(nombre, arre8[ xx ])
NEXT
RETURN
ENDPROC
Function NACIO( Arg1 )
LOCAL ll_error
DIMENSION Local1(12)
Local1(1)=31
Local1(2)=28
Local1(3)=31
Local1(4)=30
Local1(5)=31
Local1(6)=30
Local1(7)=31
Local1(8)=31
Local1(9)=30
Local1(10)=31
Local1(11)=30
Local1(12)=31
if ( Arg1 = 0 )
bb = .F.
else
todo = Str(Arg1, 8)
bb = .T.
uno = Val(SubStr(todo, 7, 2))
dos = Val(SubStr(todo, 5, 2))
tres = Val(SubStr(todo, 1, 4))
if ( Arg1 = 0 .OR. uno = 0 .OR. dos = 0 )
bb = .F.
ELSE
IF ( dos <= 0 .OR. dos > 12 )
bb = .F.
ELSE
bisies = Local1[ dos ]
sanual = Str(tres, 4)
sanual2 = Val(sanual)
if ( dos = 2 .AND. Int(sanual2 / 4) * 4 = sanual2 )
bisies = bisies + 1
endif
ENDIF
if ( bb )
if ( uno <= 0 .OR. uno > bisies )
bb = .F.
endif
endif
endif
if ( !bb )
=MESSAGEBOX('ERROR EN FECHA DE NACIMIENTO',16+0,'Error')
else
wnumer6 = SUBSTR(Str(tres, 4),3,2)
if ( dos < 10 )
wnumer6 = wnumer6 + "0" + Str(dos, 1)
else
wnumer6 = wnumer6 + Str(dos, 2)
endif
if ( uno < 10 )
wnumer6 = wnumer6 + "0" + Str(uno, 1)
else
wnumer6 = wnumer6 + Str(uno, 2)
endif
ENDIF
Return bb
ENDFUNC
Function LOS3( Arg1, Arg2, Arg3 )
paterno = Trim(Arg1)
materno = Trim(Arg2)
nombre = Trim(Arg3)
wlos3 = alltrim(alltrim(Arg1) + " " + alltrim(Arg2) + " " + ;
alltrim(Arg3))
wlos3 = strtran(wlos3, " ", " ")
IF ( Len(wlos3) <= 6 )
Return .F.
ENDIF
Return .T.
ENDFUNC
PROCEDURE HOMONI()
valores = "0"
wbase = alltrim(alltrim(wpaterno) + " " + alltrim(wmaterno) +" " + alltrim(wnombre))
FOR x = 1 TO Len(wbase)
unok = SubStr(wbase, x, 1)
IF ( unok = " " )
unok = "*"
ENDIF
van = ascan(anex11, unok)
IF ( van > 0 )
valores = valores + anex12[ van ]
ELSE
valores = valores + "00"
ENDIF
NEXT
sumas = 0
FOR x = 1 TO Len(valores) - 1
prod1 = Val(SubStr(valores, x, 2))
prod2 = Val(SubStr(valores, x + 1, 1))
prod3 = prod1 * prod2
sumas = sumas + prod3
NEXT
zumass = Str(sumas, 10, 0)
zumass = right(zumass, 3)
zumas = Val(zumass)
solotres = zumas
cociente = Int(solotres / 34)
residuo = solotres - cociente * 34
IF ( cociente < 10 )
wrok = "0" + Str(cociente, 1)
ELSE
wrok = Str(cociente, 2)
ENDIF
van = ascan(anex21, wrok)
IF ( van > 0 )
homo = anex22[ van ]
ELSE
homo = "1"
ENDIF
IF ( residuo < 10 )
wrok = "0" + Str(residuo, 1)
ELSE
wrok = Str(residuo, 2)
ENDIF
van = ascan(anex21, wrok)
IF ( van > 0 )
homo = homo + anex22[ van ]
ELSE
homo = homo + "1"
ENDIF
wrfc = SubStr(wrfc, 1, 10) + homo
RETURN
ENDPROC
PROCEDURE DIGITO()
valores = ""
FOR x = 1 TO Len(wrfc)
unok = SubStr(wrfc, x, 1)
IF unok = " "
unok = "*"
ENDIF
van = ascan(anex31, unok)
IF van > 0
valores = valores + anex32[ van ]
ELSE
valores = valores + "00"
ENDIF
NEXT
sumas = 0
trece = 13
FOR x = 1 TO 12
prod1 = Val(SubStr(valores, x * 2 - 1, 2))
prod3 = prod1 * trece
sumas = sumas + prod3
trece = trece - 1
NEXT
cociente = Int(sumas / 11)
residuo = Int(sumas) - cociente * 11
IF residuo = 0
dijito = "0"
ELSE
valor = 11 - residuo
IF ( valor = 10 )
dijito = "A"
ELSE
entrer = Str(valor, 10, 0)
dijito = right(entrer, 1)
ENDIF
ENDIF
wrfc = wrfc + dijito
RETURN
ENDPROC
CODIGO DESARROLLADO EN VISUAL FOX PRO PARA GENERAR RFC CON HOMOCLAVE Y DIGITO VERIFICADOR SEGUN HACIENDA EN MEXICO
FUNCTION GENERA_RFC(CL_PAT,CL_MAT,CL_NOM,DL_FECNAC)
DIMENSION arre8(10),arre6(4),arre2(10),arre9(1),anex11(1),anex12(1),anex31(1),anex32(1)
arre8[1]="DE "
arre8[2]="DEL "
arre8[3]="LA "
arre8[4]="LOS "
arre8[5]="LAS "
arre8[6]="Y "
arre8[7]="MC "
arre8[8]="MAC "
arre8[9]="VON "
arre8[10]="VAN "
arre6[1]="JOSE "
arre6[2]="MARIA "
arre6[3]="J "
arre6[4]="MA "
arre2[1]="A"
arre2[2]="E"
arre2[3]="I"
arre2[4]="O"
arre2[5]="U"
arre2[6]="a"
arre2[7]="e"
arre2[8]="i"
arre2[9]="o"
arre2[10]="u"
arre9[1]=""
sino = "S"
malas ="BUEIBUEYCACACACOCAGACAGOCAKACAKOCOGECOJAKOGEKOJOKAKAKULOMAMEMAMO"
malas = malas +"MEARMEASMEONMIONCOJECOJICOJOCULOFETOGUEYJOTOKACAKACOKAGA"
malas = malas + "KAGOMOCOMULAPEDAPEDOPENEPUTAPUTOQULORATARUIN"
for x = 1 to Len(malas) step 4
DIMENSION arre9(X)
arre9(X)=SubStr(malas, x, 4)
next
anex11[1] = ''
anex12[1] = ''
taba11 = "*0123456789&ABCDEFGHIJKLMNOPQRSTUVWXYZ"
taba12 = "000001020304050607080910101112131415161718192122232425262728293233343536373839"
for x = 1 to Len(taba11)
DIMENSION anex11(x),anex12(x)
anex11(x)=SubStr(taba11, x, 1)
two = x * 2 - 1
anex12(x)=SubStr(taba12, two, 2)
next
malas = ""
taba11 = ""
taba12 = ""
taba21 = "00010203040506070809101112131415161718192021222324252627282930313233"
taba22 = "123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
for x = 1 to Len(taba21) step 2
DIMENSION anex21(x),anex22(x)
anex21(x)=SubStr(taba21, x, 2)
two = ( x + 1 ) / 2
anex22(x)=SubStr(taba22, two, 1)
next
taba21 = ""
taba22 = ""
taba11 = "0123456789ABCDEFGHIJKLMN&OPQRSTUVWXYZ*"
taba12 = "0001020304050607080910111213141516171819202122232425262728293031323334353637"
anex31(1) = ''
anex32(1) = ''
FOR x = 1 to Len(taba11)
DIMENSION anex31(x),anex32(x)
anex31(x)=SubStr(taba11, x, 1)
two = (x * 2) - 1
anex32(x)=SubStr(taba12, two, 2)
NEXT
STORE SPACE(0) TO taba11,taba12,wrfc,wnumer6,wlos3
STORE Space(30) TO wpaterno,wmaterno,wnombre,paterno,materno,nombre
mask = Replicate("!", 30)
wanual = VAL(STR(YEAR(dl_fecnac),4)+PADL(ALLTRIM(STR(MONTH(dl_Fecnac),2)),2,'0')+PADL(ALLTRIM(STR(DAY(dl_fecnac),2)),2,'0'))
wpaterno = CL_PAT
wmaterno = CL_MAT
wnombre = CL_NOM
IF nacio(wanual) = .F.
=MESSAGEBOX('La Fecha de Nacimiento es Incorrecta',16+0,'Error')
RETURN SPACE(0)
ENDIF
IF los3(wpaterno, wmaterno, wnombre) = .F.
=MESSAGEBOX('El Nombre del Empleado es Incorrecto',16+0,'Error')
RETURN SPACE(0)
ENDIF
finice = .F.
octava()
sexta()
tercera()
wbase = alltrim(alltrim(paterno) + " " + alltrim(materno) +" " + alltrim(nombre))
IF ( Len(paterno) = 0 .OR. Len(materno) = 0 )
septima()
finice = .T.
ENDIF
IF ( !finice )
IF ( Len(paterno) < 3 )
cuarta()
finice = .T.
ENDIF
ENDIF
IF ( !finice )
prime_segu()
ENDIF
RETURN wrfc
ENDFUNC
PROCEDURE SHOW_IT( Arg1 )
cuatro = SubStr(Arg1, 1, 4)
van = ascan(arre9, cuatro)
if ( van > 0 )
wrfc = stuff(wrfc, 4, 1, "X")
endif
homoni()
digito()
RETURN
ENDPROC
PROCEDURE PRIME_SEGU()
letra = SubStr(paterno, 2, 1)
for x = 2 to Len(paterno)
van = ascan(arre2, SubStr(paterno, x, 1))
if ( van > 0 )
letra = arre2[ van ]
x = Len(paterno) + 8
endif
next
wrfc = SubStr(paterno, 1, 1) + letra + SubStr(materno, 1, 1) + SubStr(nombre, 1, 1)
wrfc = wrfc + wnumer6 + "000"
show_it(wrfc)
RETURN
ENDPROC
PROCEDURE TERCERA()
IF ( SubStr(nombre, 1, 2) = "CH" )
nombre = stuff(nombre, 1, 2, "C")
ELSE
IF ( SubStr(nombre, 1, 2) = "LL" )
nombre = stuff(nombre, 1, 2, "L")
ENDIF
ENDIF
IF ( SubStr(paterno, 1, 2) = "CH" )
paterno = stuff(paterno, 1, 2, "C")
ELSE
IF ( SubStr(paterno, 1, 2) = "LL" )
paterno = stuff(paterno, 1, 2, "L")
ENDIF
ENDIF
IF ( SubStr(materno, 1, 2) = "CH" )
materno = stuff(materno, 1, 2, "C")
ELSE
IF ( SubStr(materno, 1, 2) = "LL" )
materno = stuff(materno, 1, 2, "L")
ENDIF
ENDIF
RETURN
ENDPROC
********************************
PROCEDURE CUARTA()
wrfc = SubStr(paterno, 1, 1) + SubStr(materno, 1, 1) +SubStr(nombre, 1, 2) + wnumer6 + "000"
show_it(wrfc)
RETURN
ENDPROC
********************************
PROCEDURE SEXTA()
posi = At(" ", nombre)
IF ( posi > 0 )
FOR xx = 1 to ALen(arre6,1)
nombre = strtran(nombre, arre6[xx])
NEXT
ENDIF
RETURN
ENDPROC
********************************
PROCEDURE SEPTIMA()
IF ( Len(paterno) = 0 .AND. Len(materno) > 0 )
unosolo = materno
ELSE
IF ( Len(paterno) > 0 .AND. Len(materno) = 0 )
unosolo = paterno
ENDIF
ELSE
unosolo = nombre
endif
wrfc = SubStr(unosolo, 1, 2) + SubStr(nombre, 1, 2) + wnumer6 + "000"
show_it(wrfc)
RETURN
ENDPROC
********************************
PROCEDURE OCTAVA()
FOR xx = 1 to aLen(arre8,1)
paterno = strtran(paterno, arre8[ xx ])
materno = strtran(materno, arre8[ xx ])
nombre = strtran(nombre, arre8[ xx ])
NEXT
RETURN
ENDPROC
Function NACIO( Arg1 )
LOCAL ll_error
DIMENSION Local1(12)
Local1(1)=31
Local1(2)=28
Local1(3)=31
Local1(4)=30
Local1(5)=31
Local1(6)=30
Local1(7)=31
Local1(8)=31
Local1(9)=30
Local1(10)=31
Local1(11)=30
Local1(12)=31
if ( Arg1 = 0 )
bb = .F.
else
todo = Str(Arg1, 8)
bb = .T.
uno = Val(SubStr(todo, 7, 2))
dos = Val(SubStr(todo, 5, 2))
tres = Val(SubStr(todo, 1, 4))
if ( Arg1 = 0 .OR. uno = 0 .OR. dos = 0 )
bb = .F.
ELSE
IF ( dos <= 0 .OR. dos > 12 )
bb = .F.
ELSE
bisies = Local1[ dos ]
sanual = Str(tres, 4)
sanual2 = Val(sanual)
if ( dos = 2 .AND. Int(sanual2 / 4) * 4 = sanual2 )
bisies = bisies + 1
endif
ENDIF
if ( bb )
if ( uno <= 0 .OR. uno > bisies )
bb = .F.
endif
endif
endif
if ( !bb )
=MESSAGEBOX('ERROR EN FECHA DE NACIMIENTO',16+0,'Error')
else
wnumer6 = SUBSTR(Str(tres, 4),3,2)
if ( dos < 10 )
wnumer6 = wnumer6 + "0" + Str(dos, 1)
else
wnumer6 = wnumer6 + Str(dos, 2)
endif
if ( uno < 10 )
wnumer6 = wnumer6 + "0" + Str(uno, 1)
else
wnumer6 = wnumer6 + Str(uno, 2)
endif
ENDIF
Return bb
ENDFUNC
Function LOS3( Arg1, Arg2, Arg3 )
paterno = Trim(Arg1)
materno = Trim(Arg2)
nombre = Trim(Arg3)
wlos3 = alltrim(alltrim(Arg1) + " " + alltrim(Arg2) + " " + ;
alltrim(Arg3))
wlos3 = strtran(wlos3, " ", " ")
IF ( Len(wlos3) <= 6 )
Return .F.
ENDIF
Return .T.
ENDFUNC
PROCEDURE HOMONI()
valores = "0"
wbase = alltrim(alltrim(wpaterno) + " " + alltrim(wmaterno) +" " + alltrim(wnombre))
FOR x = 1 TO Len(wbase)
unok = SubStr(wbase, x, 1)
IF ( unok = " " )
unok = "*"
ENDIF
van = ascan(anex11, unok)
IF ( van > 0 )
valores = valores + anex12[ van ]
ELSE
valores = valores + "00"
ENDIF
NEXT
sumas = 0
FOR x = 1 TO Len(valores) - 1
prod1 = Val(SubStr(valores, x, 2))
prod2 = Val(SubStr(valores, x + 1, 1))
prod3 = prod1 * prod2
sumas = sumas + prod3
NEXT
zumass = Str(sumas, 10, 0)
zumass = right(zumass, 3)
zumas = Val(zumass)
solotres = zumas
cociente = Int(solotres / 34)
residuo = solotres - cociente * 34
IF ( cociente < 10 )
wrok = "0" + Str(cociente, 1)
ELSE
wrok = Str(cociente, 2)
ENDIF
van = ascan(anex21, wrok)
IF ( van > 0 )
homo = anex22[ van ]
ELSE
homo = "1"
ENDIF
IF ( residuo < 10 )
wrok = "0" + Str(residuo, 1)
ELSE
wrok = Str(residuo, 2)
ENDIF
van = ascan(anex21, wrok)
IF ( van > 0 )
homo = homo + anex22[ van ]
ELSE
homo = homo + "1"
ENDIF
wrfc = SubStr(wrfc, 1, 10) + homo
RETURN
ENDPROC
PROCEDURE DIGITO()
valores = ""
FOR x = 1 TO Len(wrfc)
unok = SubStr(wrfc, x, 1)
IF unok = " "
unok = "*"
ENDIF
van = ascan(anex31, unok)
IF van > 0
valores = valores + anex32[ van ]
ELSE
valores = valores + "00"
ENDIF
NEXT
sumas = 0
trece = 13
FOR x = 1 TO 12
prod1 = Val(SubStr(valores, x * 2 - 1, 2))
prod3 = prod1 * trece
sumas = sumas + prod3
trece = trece - 1
NEXT
cociente = Int(sumas / 11)
residuo = Int(sumas) - cociente * 11
IF residuo = 0
dijito = "0"
ELSE
valor = 11 - residuo
IF ( valor = 10 )
dijito = "A"
ELSE
entrer = Str(valor, 10, 0)
dijito = right(entrer, 1)
ENDIF
ENDIF
wrfc = wrfc + dijito
RETURN
ENDPROC
Me gustaria saber - aqui en el foro- como conseguiste el codigo fuente que tan amablemente estas regalando. Este codigo es de mi propiedad porque yo lo desarrolle desde hace mas de 10 años.
Ojala puedas contestar y responder de esto que considero un verdadero agravio a la propiedad intelectual.
Es
Ojala puedas contestar y responder de esto que considero un verdadero agravio a la propiedad intelectual.
Es
esta rutina esta generada en DBASEIV, anteriormente ya se encuentra validaddo que los nombres solo esten en mayusculas, que la ñ este sustituida por un & en nuestro caso, que el nombre este separado en paterno, maternoy nombre, tiene una falla ya que cuando solo las personas tienen un solo apellido deja un blanco en el RFC, si ustedes encuentran alguno otro pueden enviarme la coreccion por favor, si necestias el programa en algun otro lenguaje lo ponemos a tu disposicion por $150.00 o algun otro comentario llamame.
********************************************************************************
* PROGRAMA QUE GENERA EL RFC, HOMONIMIA Y DIGITO VERIFICADOR
********************************************************************************
PROCEDURE GENERFC
PARAMETERS PATERNO, MATERNO, NOMBRE, FECHA, RFC, LOGOKARF
*ENTRADA---> PATERNO APELLIDO
* MATERNO "
* NOMBRE NOMBRE(S)
* FECHANAC FECHA DE NACIMIENTO
*SALIDA ---> RFC RFC DE LA PERSONA CON HOMONIMIA Y DIGITO VERIFICADOR
* ---> LOGOKARFC .T. SE GENERA RFC
LOGOKARF = .T.
DO CASE
CASE LEN(TRIM(PATERNO))=0 .AND. LEN(TRIM(NOMBRE)) = 0
LOGOKARF = .F.
CASE LEN(TRIM(MATERNO))=0 .AND. LEN(TRIM(NOMBRE)) = 0
LOGOKARF = .F.
CASE LEN(TRIM(NOMBRE)) = 0
LOGOKARF = .F.
CASE FECHA = {}
LOGOKARF = .F.
ENDCASE
IF .NOT. LOGOKARF
RETURN
ENDIF
PALABRAS = "BUEI/CACA/CAGA/CAKA/COGE/COJE/COJO/FETO/JOTO/KACO/KAGO/KOJO/KULO/LOCO/LOKO/MAMO/MEAS/MION/MULA" +;
"BUEY/CACO/CAGO/CAKO/COJA/COJI/CULO/GUEY/KACA/KAGA/KOGE/KAKA/LOCA/LOKA/MAME/MEAR/MEON/MOCO/PEDA" +;
"PEDO/PUTA/QULO RUIN/PENE/PUTO/RATA"
VOCAL = "AEIOU"
TABLA1 = " 0 1 2 3 4 5 6 7 8 9 ¥ ¥ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z &"
TABLA1V = "00000102030405060708091010111213141516171819212223242526272829323334353637383910"
TABLA2 = " 0 1 2 3 4 5 6 7 8 9101112131415161718192021222324252627282930313233"
TABLA2V = " 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N P Q R S T U V W X Y Z"
TABLA3 = " 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N ¥ & ¥ O P Q R S T U V W X Y Z "
TABLA3V = "00010203040506070809101112131415161718192021222324242425262728293031323334353637"
ELIPA = PATERNO
ELIMA = MATERNO
ELINO = NOMBRE
DO ELIMINA WITH ELIPA
DO ELIMINA WITH ELIMA
DO ELIMINA WITH ELINO
STORE "" TO LUNO, LDOS, LTRES, LCUA
DO CARANOM WITH ELINO, LCUA
DO CASE
CASE LEN(TRIM(ELIPA)) > 2 .AND. LEN(TRIM(ELIMA)) > 2
LETRA1 = 2
DO WHILE LETRA1 <= (LEN( TRIM(ELIPA)))
IF ( AT( (SUBSTR(ELIPA,LETRA1,1)),VOCAL)) > 0
LDOS = SUBSTR(VOCAL,(AT( (SUBSTR(ELIPA,LETRA1,1)),VOCAL)),1)
EXIT
ENDIF
LETRA1 = LETRA1 + 1
ENDDO
LUNO = SUBSTR(ELIPA,1,1)
LTRES= SUBSTR(ELIMA,1,1)
CASE (LEN(TRIM(ELIPA)) > 0 .AND. LEN(TRIM(ELIPA)) <= 2 ) .AND. LEN(TRIM(ELIMA)) > 0
LUNO = SUBSTR(ELIPA,1,1)
LTRES= SUBSTR(ELIMA,1,1)
LCUA = SUBSTR(ELINO,1,2)
CASE LEN(TRIM(ELIPA)) = 0 .AND. LEN(TRIM(ELIMA)) > 0
LDOS = SUBSTR(ELIMA,1,2)
LCUA = SUBSTR(ELINO,1,2)
CASE LEN(TRIM(ELIPA)) > 0 .AND. LEN(TRIM(ELIMA)) = 0
LUNO = SUBSTR(ELIPA,1,2)
LCUA = SUBSTR(ELINO,1,2)
ENDCASE
LRFC1 = LUNO + LDOS + LTRES + LCUA
IF MONTH(FECHA) < 10
LMES = SUBSTR(STR(100+MONTH(FECHA),3,0),2,2)
ELSE
LMES = STR(MONTH(FECHA),2,0)
ENDIF
IF DAY(FECHA) < 10
LDIA = SUBSTR(STR(100+DAY(FECHA),3,0),2,2)
ELSE
LDIA = STR(DAY(FECHA),2,0)
ENDIF
LANO = SUBSTR(STR(YEAR(FECHA),4,0),3,2)
LRFC2 = LANO + LMES + LDIA
IF AT(LRFC1,PALABRAS) > 0
LRFC1 = SUBSTR(LRFC1,1,3) + "X"
ENDIF
LNOM = TRIM(PATERNO) + " " + TRIM(MATERNO) + " " + TRIM(NOMBRE)
LCADENA = "0"
LONG = LEN(LNOM)
LCON = 1
DO WHILE LCON <= LONG
LAUX = " " + SUBSTR(LNOM,LCON,1)
IF AT(LAUX,TABLA1) > 0
LCADENA = LCADENA + SUBSTR(TABLA1V,AT(LAUX,TABLA1),2)
ENDIF
LCON = LCON + 1
ENDDO
LHASTA = LEN(LCADENA)
LSUMA = 0
I = 1
DO WHILE I <= (LHASTA-1)
LSUMA = LSUMA + ( VAL(SUBSTR(LCADENA,I,2)) * VAL(SUBSTR(LCADENA,I+1,1)))
I = I + 1
ENDDO
LDI = STR(LSUMA,15,0)
LDIVI = VAL( SUBSTR(LDI,13,3))
LCIENTE = INT(LDIVI/34)
LRESIDU = MOD(LDIVI,34)
IF AT(STR(LCIENTE,2,0),TABLA2) > 0
LAUX = AT(STR(LCIENTE,2,0),TABLA2)
LHOMO1 = LTRIM(SUBSTR(TABLA2V,LAUX,2))
ENDIF
IF AT(STR(LRESIDU,2,0),TABLA2) > 0
LAUX = AT(STR(LRESIDU,2,0),TABLA2)
LHOMO2 = LTRIM(SUBSTR(TABLA2V,LAUX,2))
ENDIF
LRFCX1 = LRFC1 + LRFC2 + TRIM(LHOMO1) + TRIM(LHOMO2)
J = 1
LTRECE = 14
STORE 0 TO LSUMA2
DO WHILE J <= 12
LVALOR = 0
LX = " " + SUBSTR(LRFCX1,J,1)
IF AT(LX,TABLA3) > 0
LAUX = AT(LX,TABLA3)
LVALOR = VAL(SUBSTR(TABLA3V,LAUX,2))
ENDIF
LSUMA2 = LSUMA2 + ( LVALOR * (LTRECE-J))
J = J + 1
ENDDO
LDIGITO = MOD(LSUMA2,11)
IF LDIGITO = 0
LDIG = "0"
ELSE
LDIGITO = 11 - LDIGITO
IF LDIGITO = 10
LDIG = "A"
ELSE
LDIG = STR(LDIGITO,1,0)
ENDIF
ENDIF
RFC = LRFCX1 + LTRIM(LDIG)
RETURN
********************************************************************************
* ELIMINACION DE LOS ARTICULOS,PREPOSICIONES,CONJUNCIONES O CONTARCIONES
* DE LOS APELLIDOS PATERNO Y MATERNO
********************************************************************************
PROCEDURE ELIMINA
PARAMETERS NAME
*ENTRADA ---> NAME NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE
NAME1 = TRIM(NAME)
LONG = LEN(NAME1)
LX = 1
LNVONAME = ""
LTEMP = ""
DO WHILE LX < LONG
IF AT(" ",NAME1) > 0
LTEMP = ""
LAUX = AT(" ",NAME1)
LTEMP = SUBSTR(NAME1,1,LAUX-1)
NAME1 = SUBSTR(NAME1,LAUX+1,(LONG-LEN(LTEMP))-1) && FORMA EL NVO NOMBRE
IF LTEMP = "DE" .OR. LTEMP = "LA" .OR. LTEMP = "LOS" .OR. LTEMP = "DEL" .OR. LTEMP = "LAS" .OR. LTEMP="Y"
LX = LX + (LEN(LTEMP) + 1)
IF LX = LONG
LNVONAME = NAME1
ENDIF
ELSE
LX = LX + LEN(LTEMP)
LNVONAME = LNVONAME + (LTEMP + " ")
ENDIF
ELSE
IF LX = 1
LNVONAME = NAME1
LX = LONG
ELSE
LNVONAME = LNVONAME + NAME1
LX = LX + LEN(NAME1)
ENDIF
ENDIF
ENDDO
NAME = TRIM(LNVONAME)
RETURN
********************************************************************************
* FORMACION DE LA PRIMERA LETRA DEL NOMBRE PARA EL RFC AUN COMPUESTO EL NOMBRE
********************************************************************************
PROCEDURE CARANOM
PARAMETERS NAME, INICIAL
*ENTRADA ---> NAME NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE
NAME1 = TRIM(NAME)
IF (NAME1="JOSE" .AND. LEN(NAME1)=4) .OR. (NAME1 = "MARIA" .AND. LEN(NAME1)=5)
INICIAL = SUBSTR(NAME1,1,1) && EL NOMBRE ES SOLO MARIA O JOSE
ELSE
IF AT(" ",NAME1) = 0
INICIAL = SUBSTR(NAME1,1,1) && EL NOMBRE NO ES COMPUESTO Y NO ES MARIA O JOSE
ELSE
IF AT(" ",NAME1) > 0
LTEMP = ""
LAUX = AT(" ",NAME1)
LTEMP = SUBSTR(NAME1,1,LAUX-1)
IF LTEMP = "MARIA" .OR. LTEMP = "JOSE"
INICIAL = SUBSTR(NAME1,LAUX+1,1) && EL NOMBRE INICIAL ES JOSE O MARIA
ELSE
INICIAL = SUBSTR(NAME1,1,1) && EL NOMBRE ES COMPUESTO Y NO ES MARIA O JOSE
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
********************************************************************************
* PROGRAMA QUE GENERA EL RFC, HOMONIMIA Y DIGITO VERIFICADOR
********************************************************************************
PROCEDURE GENERFC
PARAMETERS PATERNO, MATERNO, NOMBRE, FECHA, RFC, LOGOKARF
*ENTRADA---> PATERNO APELLIDO
* MATERNO "
* NOMBRE NOMBRE(S)
* FECHANAC FECHA DE NACIMIENTO
*SALIDA ---> RFC RFC DE LA PERSONA CON HOMONIMIA Y DIGITO VERIFICADOR
* ---> LOGOKARFC .T. SE GENERA RFC
LOGOKARF = .T.
DO CASE
CASE LEN(TRIM(PATERNO))=0 .AND. LEN(TRIM(NOMBRE)) = 0
LOGOKARF = .F.
CASE LEN(TRIM(MATERNO))=0 .AND. LEN(TRIM(NOMBRE)) = 0
LOGOKARF = .F.
CASE LEN(TRIM(NOMBRE)) = 0
LOGOKARF = .F.
CASE FECHA = {}
LOGOKARF = .F.
ENDCASE
IF .NOT. LOGOKARF
RETURN
ENDIF
PALABRAS = "BUEI/CACA/CAGA/CAKA/COGE/COJE/COJO/FETO/JOTO/KACO/KAGO/KOJO/KULO/LOCO/LOKO/MAMO/MEAS/MION/MULA" +;
"BUEY/CACO/CAGO/CAKO/COJA/COJI/CULO/GUEY/KACA/KAGA/KOGE/KAKA/LOCA/LOKA/MAME/MEAR/MEON/MOCO/PEDA" +;
"PEDO/PUTA/QULO RUIN/PENE/PUTO/RATA"
VOCAL = "AEIOU"
TABLA1 = " 0 1 2 3 4 5 6 7 8 9 ¥ ¥ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z &"
TABLA1V = "00000102030405060708091010111213141516171819212223242526272829323334353637383910"
TABLA2 = " 0 1 2 3 4 5 6 7 8 9101112131415161718192021222324252627282930313233"
TABLA2V = " 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N P Q R S T U V W X Y Z"
TABLA3 = " 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N ¥ & ¥ O P Q R S T U V W X Y Z "
TABLA3V = "00010203040506070809101112131415161718192021222324242425262728293031323334353637"
ELIPA = PATERNO
ELIMA = MATERNO
ELINO = NOMBRE
DO ELIMINA WITH ELIPA
DO ELIMINA WITH ELIMA
DO ELIMINA WITH ELINO
STORE "" TO LUNO, LDOS, LTRES, LCUA
DO CARANOM WITH ELINO, LCUA
DO CASE
CASE LEN(TRIM(ELIPA)) > 2 .AND. LEN(TRIM(ELIMA)) > 2
LETRA1 = 2
DO WHILE LETRA1 <= (LEN( TRIM(ELIPA)))
IF ( AT( (SUBSTR(ELIPA,LETRA1,1)),VOCAL)) > 0
LDOS = SUBSTR(VOCAL,(AT( (SUBSTR(ELIPA,LETRA1,1)),VOCAL)),1)
EXIT
ENDIF
LETRA1 = LETRA1 + 1
ENDDO
LUNO = SUBSTR(ELIPA,1,1)
LTRES= SUBSTR(ELIMA,1,1)
CASE (LEN(TRIM(ELIPA)) > 0 .AND. LEN(TRIM(ELIPA)) <= 2 ) .AND. LEN(TRIM(ELIMA)) > 0
LUNO = SUBSTR(ELIPA,1,1)
LTRES= SUBSTR(ELIMA,1,1)
LCUA = SUBSTR(ELINO,1,2)
CASE LEN(TRIM(ELIPA)) = 0 .AND. LEN(TRIM(ELIMA)) > 0
LDOS = SUBSTR(ELIMA,1,2)
LCUA = SUBSTR(ELINO,1,2)
CASE LEN(TRIM(ELIPA)) > 0 .AND. LEN(TRIM(ELIMA)) = 0
LUNO = SUBSTR(ELIPA,1,2)
LCUA = SUBSTR(ELINO,1,2)
ENDCASE
LRFC1 = LUNO + LDOS + LTRES + LCUA
IF MONTH(FECHA) < 10
LMES = SUBSTR(STR(100+MONTH(FECHA),3,0),2,2)
ELSE
LMES = STR(MONTH(FECHA),2,0)
ENDIF
IF DAY(FECHA) < 10
LDIA = SUBSTR(STR(100+DAY(FECHA),3,0),2,2)
ELSE
LDIA = STR(DAY(FECHA),2,0)
ENDIF
LANO = SUBSTR(STR(YEAR(FECHA),4,0),3,2)
LRFC2 = LANO + LMES + LDIA
IF AT(LRFC1,PALABRAS) > 0
LRFC1 = SUBSTR(LRFC1,1,3) + "X"
ENDIF
LNOM = TRIM(PATERNO) + " " + TRIM(MATERNO) + " " + TRIM(NOMBRE)
LCADENA = "0"
LONG = LEN(LNOM)
LCON = 1
DO WHILE LCON <= LONG
LAUX = " " + SUBSTR(LNOM,LCON,1)
IF AT(LAUX,TABLA1) > 0
LCADENA = LCADENA + SUBSTR(TABLA1V,AT(LAUX,TABLA1),2)
ENDIF
LCON = LCON + 1
ENDDO
LHASTA = LEN(LCADENA)
LSUMA = 0
I = 1
DO WHILE I <= (LHASTA-1)
LSUMA = LSUMA + ( VAL(SUBSTR(LCADENA,I,2)) * VAL(SUBSTR(LCADENA,I+1,1)))
I = I + 1
ENDDO
LDI = STR(LSUMA,15,0)
LDIVI = VAL( SUBSTR(LDI,13,3))
LCIENTE = INT(LDIVI/34)
LRESIDU = MOD(LDIVI,34)
IF AT(STR(LCIENTE,2,0),TABLA2) > 0
LAUX = AT(STR(LCIENTE,2,0),TABLA2)
LHOMO1 = LTRIM(SUBSTR(TABLA2V,LAUX,2))
ENDIF
IF AT(STR(LRESIDU,2,0),TABLA2) > 0
LAUX = AT(STR(LRESIDU,2,0),TABLA2)
LHOMO2 = LTRIM(SUBSTR(TABLA2V,LAUX,2))
ENDIF
LRFCX1 = LRFC1 + LRFC2 + TRIM(LHOMO1) + TRIM(LHOMO2)
J = 1
LTRECE = 14
STORE 0 TO LSUMA2
DO WHILE J <= 12
LVALOR = 0
LX = " " + SUBSTR(LRFCX1,J,1)
IF AT(LX,TABLA3) > 0
LAUX = AT(LX,TABLA3)
LVALOR = VAL(SUBSTR(TABLA3V,LAUX,2))
ENDIF
LSUMA2 = LSUMA2 + ( LVALOR * (LTRECE-J))
J = J + 1
ENDDO
LDIGITO = MOD(LSUMA2,11)
IF LDIGITO = 0
LDIG = "0"
ELSE
LDIGITO = 11 - LDIGITO
IF LDIGITO = 10
LDIG = "A"
ELSE
LDIG = STR(LDIGITO,1,0)
ENDIF
ENDIF
RFC = LRFCX1 + LTRIM(LDIG)
RETURN
********************************************************************************
* ELIMINACION DE LOS ARTICULOS,PREPOSICIONES,CONJUNCIONES O CONTARCIONES
* DE LOS APELLIDOS PATERNO Y MATERNO
********************************************************************************
PROCEDURE ELIMINA
PARAMETERS NAME
*ENTRADA ---> NAME NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE
NAME1 = TRIM(NAME)
LONG = LEN(NAME1)
LX = 1
LNVONAME = ""
LTEMP = ""
DO WHILE LX < LONG
IF AT(" ",NAME1) > 0
LTEMP = ""
LAUX = AT(" ",NAME1)
LTEMP = SUBSTR(NAME1,1,LAUX-1)
NAME1 = SUBSTR(NAME1,LAUX+1,(LONG-LEN(LTEMP))-1) && FORMA EL NVO NOMBRE
IF LTEMP = "DE" .OR. LTEMP = "LA" .OR. LTEMP = "LOS" .OR. LTEMP = "DEL" .OR. LTEMP = "LAS" .OR. LTEMP="Y"
LX = LX + (LEN(LTEMP) + 1)
IF LX = LONG
LNVONAME = NAME1
ENDIF
ELSE
LX = LX + LEN(LTEMP)
LNVONAME = LNVONAME + (LTEMP + " ")
ENDIF
ELSE
IF LX = 1
LNVONAME = NAME1
LX = LONG
ELSE
LNVONAME = LNVONAME + NAME1
LX = LX + LEN(NAME1)
ENDIF
ENDIF
ENDDO
NAME = TRIM(LNVONAME)
RETURN
********************************************************************************
* FORMACION DE LA PRIMERA LETRA DEL NOMBRE PARA EL RFC AUN COMPUESTO EL NOMBRE
********************************************************************************
PROCEDURE CARANOM
PARAMETERS NAME, INICIAL
*ENTRADA ---> NAME NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE
NAME1 = TRIM(NAME)
IF (NAME1="JOSE" .AND. LEN(NAME1)=4) .OR. (NAME1 = "MARIA" .AND. LEN(NAME1)=5)
INICIAL = SUBSTR(NAME1,1,1) && EL NOMBRE ES SOLO MARIA O JOSE
ELSE
IF AT(" ",NAME1) = 0
INICIAL = SUBSTR(NAME1,1,1) && EL NOMBRE NO ES COMPUESTO Y NO ES MARIA O JOSE
ELSE
IF AT(" ",NAME1) > 0
LTEMP = ""
LAUX = AT(" ",NAME1)
LTEMP = SUBSTR(NAME1,1,LAUX-1)
IF LTEMP = "MARIA" .OR. LTEMP = "JOSE"
INICIAL = SUBSTR(NAME1,LAUX+1,1) && EL NOMBRE INICIAL ES JOSE O MARIA
ELSE
INICIAL = SUBSTR(NAME1,1,1) && EL NOMBRE ES COMPUESTO Y NO ES MARIA O JOSE
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
hola , entra a la sig. pagina www.aplicarh.com ahi encotraras gratis el programa para el calculo del rfc y del curp. espero te sirva, mandame mensaje a mi correo de [email protected] para saber si lolograste
juan.
juan.
El precio del algoritmo es de $150.00 el cual incluye
el algoritmo y que me envies tus rfc's en archivo plano
y yo te envio el mismo con el calculo. El pago es en deposito
Bancario, dudas escribeme..
el algoritmo y que me envies tus rfc's en archivo plano
y yo te envio el mismo con el calculo. El pago es en deposito
Bancario, dudas escribeme..
En respuesta a los comentarios referentes a quienes requieren algoritmos, porque no hacemos lo siguiente: aquellos que desarrollemos programas porque no subimos nuestros codigos. Actualmente estoy trabajando (fase de pruebas) en el codigo en C# para NET 2.0, proximamente lo subire.
Todo quien desee saber su CURP y RFC, asi como el de Cualquier Ciudadano Mexicano, entre al siguiente sitio web:
http://articulo.mercadolibre.com.mx/MLM-11140969-averigua-curp-y-rfc-completas-de-cualquier-mexicano-_JM
Yo ya tengo el programa y esta exelente, infaliblre!
http://articulo.mercadolibre.com.mx/MLM-11140969-averigua-curp-y-rfc-completas-de-cualquier-mexicano-_JM
Yo ya tengo el programa y esta exelente, infaliblre!
Todo quien desee saber su CURP y RFC, asi como el de Cualquier Ciudadano Mexicano, entre al siguiente sitio web:
http://articulo.mercadolibre.com.mx/MLM-11140969-averigua-curp-y-rfc-completas-de-cualquier-mexicano-_JM
Yo ya tengo el programa y esta exelente, infaliblre!
http://articulo.mercadolibre.com.mx/MLM-11140969-averigua-curp-y-rfc-completas-de-cualquier-mexicano-_JM
Yo ya tengo el programa y esta exelente, infaliblre!
LA VERDAD ME INTERESA EL PROGRAMA DE PODER CALCULAR EL RFC Y LA CURP PERO NO ENCUENTRO DONDE DESCARGARLO SI ME PUDIERAS MANDAR LA DIRECCION CORRECTA TE LO AGRADESERE O MI SE PUEDES MANDAR A MI CORREO EL PROGRAMA TE LO AGRADESE MAS GARCIAS ATTE LUIS TORRES [email protected]
Como hay gente tan floja, quieren que todo se lo den peladito y en la boca, quien sabe cuantas veces han puesto la pagina de donde pueden bajar este programa y siguen preguntando, Gente lea por favor, por eso Mexico esta como esta, por gente como ustedes que quieren todo facil, Advierto no es para todos, para los que quieren desarrollar, un aplauso y mis mas sinceras felicitaciones. Gente Lea
existe un programa para calcularlo pero solo te calcula el de personas.
lo puedes bajar en www.alicarh.netfirms.com.mx
porfa si consigues alguno que calcule el de empresas avisame....
lo puedes bajar en www.alicarh.netfirms.com.mx
porfa si consigues alguno que calcule el de empresas avisame....
podria alguien ayudarme y decirme como puedo sacar mi homonimia y mi RFC gracias
envio un paquete , espero les ayude, me falta el homonimo del CURP y necesito el del IMSS
Gracias
CREATE OR REPLACE PACKAGE genera_claves AS
FUNCTION consonantes(
elipa VARCHAR2
,elima VARCHAR2
,elino VARCHAR2)
RETURN VARCHAR2;
FUNCTION caranom(
nombre VARCHAR2)
RETURN VARCHAR2;
FUNCTION elimina(
nombre VARCHAR2)
RETURN VARCHAR2;
FUNCTION genera_rfc(
apaterno VARCHAR2
,amaterno VARCHAR2
,nombres VARCHAR2
,fecha DATE)
RETURN VARCHAR2;
FUNCTION genera_curp(
apaterno VARCHAR2
,amaterno VARCHAR2
,nombres VARCHAR2
,fecha DATE
,sexo VARCHAR2
,lnacimiento VARCHAR2)
RETURN VARCHAR2;
FUNCTION genera_imss (fecha_nac DATE, fecha_ing DATE)
RETURN VARCHAR2;
PROCEDURE genera_claves (
errbuf OUT VARCHAR2
,retcode OUT VARCHAR2
,rfc OUT VARCHAR2
,curp OUT VARCHAR2
,imss OUT VARCHAR2
,apaterno IN VARCHAR2
,amaterno IN VARCHAR2
,nombres IN VARCHAR2
,fecha IN DATE
,fecha_ing IN DATE
,sexo IN VARCHAR2
,lnacimiento IN VARCHAR2);
END;
CREATE OR REPLACE PACKAGE BODY genera_claves AS
FUNCTION consonantes (elipa VARCHAR2 , elima VARCHAR2 , elino VARCHAR2 ) RETURN VARCHAR2 IS
vocal VARCHAR2(5);
letra2 NUMBER(3);
luno VARCHAR2(1);
ldos VARCHAR2(1);
ltres VARCHAR2(1);
lcua VARCHAR2(1);
BEGIN
vocal := 'AEIOU';
IF LENGTH(elipa) > 2 AND LENGTH(elima) > 2 THEN
FOR letra1 IN 2..LENGTH(elipa) LOOP
IF INSTR(vocal, SUBSTR(elipa, letra1, 1) ) = 0 THEN
luno := SUBSTR(elipa, letra1, 1);
EXIT;
END IF;
END LOOP;
FOR letra1 IN 2..LENGTH(elima) LOOP
IF INSTR(vocal, SUBSTR(elima, letra1, 1) ) = 0 THEN
ldos := SUBSTR(elima, letra1, 1);
EXIT;
END IF;
END LOOP;
FOR letra1 IN 2..LENGTH(elino) LOOP
IF INSTR(vocal, SUBSTR(elino, letra1, 1) ) = 0 THEN
ltres := SUBSTR(elino, letra1, 1);
EXIT;
END IF;
END LOOP;
END IF;
return (luno||ldos||ltres);
END;
FUNCTION elimina( nombre VARCHAR2) RETURN VARCHAR2 IS
/*PARAMETERS NOMBRE
*ENTRADA ---> NOMBRE NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE */
nombre1 VARCHAR2(240);
longitud NUMBER;
lx NUMBER;
laux NUMBER;
lnvonombre VARCHAR2(240);
ltemp VARCHAR2(240);
sin_nom VARCHAR2(240);
BEGIN
nombre1 := nombre;
longitud := LENGTH(nombre1);
lx := 1;
lnvonombre := '';
ltemp := '';
LOOP
IF INSTR(nombre1, ' ') > 0 THEN
ltemp := '';
laux := INSTR(nombre1, ' ');
ltemp := SUBSTR(nombre1, 1, laux - 1);
nombre1 := SUBSTR(nombre1,laux + 1,(longitud - LENGTH(ltemp) ) - 1); -- FORMA EL NVO NOMBRE
IF ltemp IN('DE' ,'DEL' ,'LA' ,'LOS' ,'LAS' ,'Y' ,'MC' ,'MAC' ,'VON' ,'VAN') THEN
lx := lx + (LENGTH(ltemp) + 1);
IF lx = longitud THEN
lnvonombre := nombre1;
END IF;
ELSE
lx := lx + LENGTH(ltemp);
lnvonombre := lnvonombre || ltemp || ' ';
END IF;
ELSE
IF lx = 1 THEN
lnvonombre := nombre1;
lx := longitud;
ELSE
lnvonombre := lnvonombre || nombre1;
lx := lx + LENGTH(nombre1);
END IF;
END IF;
EXIT WHEN lx >= longitud;
END LOOP;
sin_nom := RTRIM(LTRIM(lnvonombre) );
RETURN (sin_nom);
END;
FUNCTION caranom(nombre IN VARCHAR2) RETURN VARCHAR2 IS
/*ENTRADA ---> NAME NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE*/
nombre1 VARCHAR2(240);
inicial VARCHAR2(240);
ltemp VARCHAR2(240);
laux NUMBER;
BEGIN
nombre1 := nombre;
IF (nombre1 = 'JOSE' AND LENGTH(nombre1) = 4)
OR (nombre1 = 'MARIA' AND LENGTH(nombre1) = 5) THEN
inicial := SUBSTR(nombre1, 1, 1); --- EL NOMBRE ES SOLO MARIA O JOSE
ELSE
IF INSTR(nombre1, ' ') = 0 THEN
inicial := SUBSTR(nombre1, 1, 1); --- EL NOMBRE NO ES COMPUESTO Y NO ES MARIA O JOSE
ELSE
IF INSTR(nombre1, ' ') > 0 THEN
ltemp := ' ';
laux := INSTR(nombre1, ' ');
ltemp := SUBSTR(nombre1, 1, laux - 1);
IF ltemp IN('MARIA', 'JOSE', 'J', 'MA') THEN
inicial := SUBSTR(nombre1, laux + 1, 1); ---- EL NOMBRE INICIAL ES JOSE O MARIA
ELSE
inicial := SUBSTR(nombre1, 1, 1); ---- EL NOMBRE ES COMPUESTO Y NO ES MARIA O JOSE
END IF;
END IF;
END IF;
END IF;
RETURN inicial;
END;
FUNCTION genera_rfc( apaterno VARCHAR2 ,amaterno VARCHAR2 ,nombres VARCHAR2 ,fecha DATE) RETURN VARCHAR2 IS
/*
PARAMETERS PATERNO, MATERNO, NOMBRE, FECHA, RFC, LOGOKARF
*ENTRADA---> PATERNO APELLIDO
* MATERNO '
* NOMBRE NOMBRE(S)
* FECHANAC FECHA DE NACIMIENTO
*SALIDA ---> RFC RFC DE LA PERSONA CON HOMONIMIA Y DIGITO VERIFICADOR
* ---> LOGOKARFC .T. SE GENERA RFC */
TYPE charlist IS TABLE OF VARCHAR2(2000);
anex11 charlist;
anex12 charlist;
anex21 charlist;
anex22 charlist;
anex31 charlist;
anex32 charlist;
valores VARCHAR2(100);
unok VARCHAR2(1000);
van NUMBER;
x1 NUMBER := 1;
sumas NUMBER;
zumas NUMBER;
zumass VARCHAR2(100);
solotres NUMBER;
cociente NUMBER;
residuo NUMBER;
wrok VARCHAR2(1000);
homo VARCHAR2(100);
wbase VARCHAR2(2000);
longi NUMBER;
wrfc VARCHAR2(2000);
x NUMBER := 1;
two NUMBER;
longit NUMBER;
valor VARCHAR2(2);
palabras VARCHAR2(2000);
vocal VARCHAR2(5);
elipa VARCHAR2(1000);
elima VARCHAR2(1000);
elino VARCHAR2(1000);
laux VARCHAR2(1000);
luno VARCHAR2(1000);
ldos VARCHAR2(1000);
ltres VARCHAR2(1000);
lcua VARCHAR2(1000);
letra1 NUMBER;
lrfc1 VARCHAR2(12);
lrfc2 VARCHAR2(13);
lmes VARCHAR2(2);
ldia VARCHAR2(2);
lano VARCHAR2(2);
lnom VARCHAR2(1000);
lcadena VARCHAR2(10);
lsuma NUMBER;
ltrece NUMBER;
i NUMBER;
j NUMBER;
lrfcx1 VARCHAR2(15);
ldigito VARCHAR2(2);
prod1 NUMBER;
prod2 NUMBER;
prod3 NUMBER;
rfc VARCHAR2(15);
entrer NUMBER;
BEGIN
IF LENGTH(apaterno) = 0 AND LENGTH(amaterno) = 0 THEN
RETURN (' SIN APELLIDOS ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF fecha IS NULL THEN
RETURN (' SIN FECHA ');
END IF;
palabras := 'BUEI/CACA/CAGA/CAKA/COGE/COJE/COJO/FETO/JOTO/KACO/KAGO/KOJO/KULO/LOCO/LOKO/MAMO/MEAS/MION/MULA'
|| 'BUEY/CACO/CAGO/CAKO/COJA/COJI/CULO/GUEY/KACA/KAGA/KOGE/KAKA/LOCA/LOKA/MAME/MEAR/MEON/MOCO/PEDA'
|| 'PEDO/PUTA/QULO RUIN/PENE/PUTO/RATA';
vocal := 'AEIOU';
anex11 := charList('*','0','1','2','3','4','5','6','7','8','9','&','\','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
anex12 := charList('00','00','01','02','03','04','05','06','07','08','09','10','10','11','12','13','14','15','16','17','18','19','21','22','23','24','25','26','27','28','29','32','33','34','35','36','37','38','39');
anex21 := charList('00','01','02','03','04','05','06','07','08','09','10','11','12','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31','32','33');
anex22 := charList('1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K','L','M','N','P','Q','R','S','T','U','V','W','X','Y','Z');
anex31 := charList('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K','L','M','N','&','O','P','Q','R','S','T','U','V','W','X','Y','Z','*');
anex32 := charList('00','01','02','03','04','05','06','07','08','09','10','11','12','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31','32','33','34','35','36','37');
elipa := apaterno;
elima := amaterno;
elino := nombres;
elipa := genera_claves.elimina(apaterno);
elima := genera_claves.elimina(amaterno);
elino := genera_claves.elimina(nombres);
luno := '';
ldos := '';
ltres := '';
lcua := '';
elino := genera_claves.caranom(elino);
IF LENGTH(elipa) > 2 AND LENGTH(elima) > 2 THEN
letra1 := 2;
LOOP
IF INSTR(vocal, SUBSTR(elipa, letra1, 1) ) > 0 THEN
ldos := SUBSTR( vocal ,INSTR(vocal, SUBSTR(elipa, letra1, 1) ) ,1);
EXIT;
END IF;
letra1 := letra1 + 1;
EXIT WHEN letra1 > LENGTH(elipa);
END LOOP;
luno := SUBSTR(elipa, 1, 1);
ltres := SUBSTR(elima, 1, 1);
lcua := SUBSTR(elino, 1, 1);
ELSIF (LENGTH(elipa) > 0 AND LENGTH(elipa) <= 2) AND LENGTH(elima) > 0 THEN
luno := SUBSTR(elipa, 1, 1);
ltres := SUBSTR(elima, 1, 1);
lcua := SUBSTR(elino, 1, 2);
ELSIF LENGTH(TRIM(elipa) ) = 0 AND LENGTH(TRIM(elima) ) > 0 THEN
ldos := SUBSTR(elima, 1, 2);
lcua := SUBSTR(elino, 1, 1);
ELSIF LENGTH(TRIM(elipa) ) > 0 AND LENGTH(TRIM(elima) ) = 0 THEN
luno := SUBSTR(elipa, 1, 2);
lcua := SUBSTR(elino, 1, 1);
END IF;
lrfc1 := luno || ldos || ltres || lcua;
lmes := LPAD(TO_CHAR(fecha, 'MM'), 2, 0);
ldia := LPAD(TO_CHAR(fecha, 'DD'), 2, 0);
lano := LPAD(TO_CHAR(fecha, 'YY'), 2, 0);
lrfc2 := lano || lmes || ldia;
IF INSTR(palabras, lrfc1) > 0 THEN
lrfc1 := SUBSTR(lrfc1, 1, 3) || 'X';
END IF;
lnom := TRIM(apaterno) || ' ' || TRIM(amaterno) || ' ' || TRIM(nombres);
lcadena := '0';
-- longitud := LENGTH(lnom);
valores := '0';
wbase := LTRIM( LTRIM(apaterno) || ' ' || LTRIM(amaterno) || ' ' || LTRIM( nombres) );
FOR x IN 1 .. LENGTH(wbase) LOOP
unok := SUBSTR(wbase, x, 1);
IF (unok = ' ') THEN
unok := '*';
END IF;
x1 := 1;
LOOP
IF anex11(x1) = unok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF (van > 0) THEN
valores := valores || anex12(van);
ELSE
valores := valores || '00';
END IF;
END LOOP;
sumas := 0;
FOR x IN 1 .. LENGTH(valores) - 1 LOOP
prod1 := TO_NUMBER(SUBSTR(valores, x, 2) );
prod2 := TO_NUMBER(SUBSTR(valores, x + 1, 1) );
prod3 := prod1 * prod2;
sumas := sumas + prod3;
END LOOP;
zumass := TO_CHAR(sumas);
--- zumass := right(zumass, 3);
longi := LENGTH(zumass) - 2;
zumass := SUBSTR(zumass, LENGTH(zumass) - 2, 3);
zumas := TO_NUMBER(zumass);
solotres := zumas;
cociente := TRUNC(solotres / 34, 0);
residuo := MOD(solotres, 34);
IF (cociente < 10) THEN
wrok := '0' + TO_CHAR(cociente, 1);
ELSE
wrok := TO_CHAR(cociente);
END IF;
x1 := 1;
LOOP
IF anex21(x1) = wrok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF (van > 0) THEN
homo := anex22(van);
ELSE
homo := '1';
END IF;
IF (residuo < 10) THEN
wrok := '0' + TO_CHAR(residuo);
ELSE
wrok := TO_CHAR(residuo);
END IF;
x1 := 1;
LOOP
IF anex21(x1) = wrok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF (van > 0) THEN
homo := homo || anex22(van);
ELSE
homo := homo || '1';
END IF;
lrfcx1 := lrfc1 || lrfc2 || homo;
valores := '';
FOR x IN 1 .. LENGTH(lrfcx1) LOOP
unok := SUBSTR(lrfcx1, x, 1);
IF unok = ' ' THEN
unok := '*';
END IF;
x1 := 1;
LOOP
IF anex31(x1) = unok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF van > 0 THEN
valores := valores || anex32(van);
ELSE
valores := valores || '00';
END IF;
END LOOP;
sumas := 0;
ltrece := 13;
FOR x IN 1 .. 12 LOOP
prod1 := TO_NUMBER(SUBSTR(valores, x * 2 - 1, 2) );
prod3 := prod1 * ltrece;
sumas := sumas + prod3;
ltrece := ltrece - 1;
END LOOP;
cociente := TRUNC(sumas / 11, 0);
residuo := MOD(sumas, 11);
IF residuo = 0 THEN
ldigito := '0';
ELSE
valor := 11 - residuo;
IF (valor = 10) THEN
ldigito := 'A';
ELSE
entrer := TO_CHAR(valor);
ldigito := SUBSTR(entrer, 1, 1);
--- right(entrer, 1);
END IF;
END IF;
rfc := lrfcx1 || LTRIM(ldigito);
RETURN (rfc);
END;
FUNCTION genera_curp(apaterno VARCHAR2
,amaterno VARCHAR2
,nombres VARCHAR2
,fecha DATE
,sexo VARCHAR2
,lnacimiento VARCHAR2) RETURN VARCHAR2 IS
PRIMERA VARCHAR2(10);
CONSONANTES VARCHAR2(3);
DIGITO1 VARCHAR2(1);
DIGITO2 VARCHAR2(1);
CURP VARCHAR2(18);
BEGIN
IF LENGTH(apaterno) = 0 AND LENGTH(amaterno) = 0 THEN
RETURN (' SIN APELLIDOS ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF fecha IS NULL THEN
RETURN (' SIN FECHA ');
END IF;
PRIMERA := substr(genera_claves.genera_rfc (apaterno, amaterno, nombres, fecha),1,10);
DIGITO2 := substr(genera_claves.genera_rfc (apaterno, amaterno, nombres, fecha),13,1);
CONSONANTES := genera_claves.consonantes (apaterno, amaterno, nombres);
IF TO_CHAR(FECHA,'YYYY') < 2000 THEN
DIGITO1 := 0;
ELSE
DIGITO1 := 1;
END IF;
/* El sexo es H Hombre, M Mujer */
/* Las claves de Estado son
AGUASCALIENTES AS MORELOS MS
BAJA CALIFORNIA BC NAYARIT NT
BAJA CALIFORNIA SUR BS NUEVO LEON NL
CAMPECHE CC OAXACA OC
CHIAPAS CS PUEBLA PL
CHIHUAHUA CH QUERETARO QT
COAHUILA CL QUINTANA ROO QR
COLIMA CM SAN LUIS POTOSI SP
DISTRITO FEDERAL DF SINALOA SL
DURANGO DG SONORA SR
GUANAJUATO GT TABASCO TC
GUERRERO GR TAMAULIPAS TS
HIDALGO HG TLAXCALA TL
JALISCO JC VERACRUZ VZ
MEXICO MC YUCATÁN YN
MICHOACAN MN ZACATECAS ZS
NE para los extranjeros */
CURP := PRIMERA||SEXO||LNACIMIENTO||CONSONANTES||DIGITO1||DIGITO2;
RETURN (CURP);
END;
FUNCTION genera_imss (fecha_nac DATE, fecha_ing DATE) RETURN VARCHAR2 IS
clave VARCHAR2(11);
BEGIN
clave := '12345678901';
---to_char(fecha_nac,'YY')||to_char(fecha_ing,'YY');
RETURN (clave);
END;
PROCEDURE genera_claves (
errbuf OUT VARCHAR2
,retcode OUT VARCHAR2
,rfc OUT VARCHAR2
,curp OUT VARCHAR2
,imss OUT VARCHAR2
,apaterno IN VARCHAR2
,amaterno IN VARCHAR2
,nombres IN VARCHAR2
,fecha IN DATE
,fecha_ing IN DATE
,sexo IN VARCHAR2
,lnacimiento IN VARCHAR2) IS
BEGIN
rfc := substr(genera_claves.genera_rfc (apaterno, amaterno, nombres, fecha),1,13);
curp := substr(genera_claves.genera_curp (apaterno, amaterno, nombres, fecha, sexo, lnacimiento),1,18);
imss := substr(genera_claves.genera_imss (fecha, fecha_ing),1,11);
END;
END;
Gracias
CREATE OR REPLACE PACKAGE genera_claves AS
FUNCTION consonantes(
elipa VARCHAR2
,elima VARCHAR2
,elino VARCHAR2)
RETURN VARCHAR2;
FUNCTION caranom(
nombre VARCHAR2)
RETURN VARCHAR2;
FUNCTION elimina(
nombre VARCHAR2)
RETURN VARCHAR2;
FUNCTION genera_rfc(
apaterno VARCHAR2
,amaterno VARCHAR2
,nombres VARCHAR2
,fecha DATE)
RETURN VARCHAR2;
FUNCTION genera_curp(
apaterno VARCHAR2
,amaterno VARCHAR2
,nombres VARCHAR2
,fecha DATE
,sexo VARCHAR2
,lnacimiento VARCHAR2)
RETURN VARCHAR2;
FUNCTION genera_imss (fecha_nac DATE, fecha_ing DATE)
RETURN VARCHAR2;
PROCEDURE genera_claves (
errbuf OUT VARCHAR2
,retcode OUT VARCHAR2
,rfc OUT VARCHAR2
,curp OUT VARCHAR2
,imss OUT VARCHAR2
,apaterno IN VARCHAR2
,amaterno IN VARCHAR2
,nombres IN VARCHAR2
,fecha IN DATE
,fecha_ing IN DATE
,sexo IN VARCHAR2
,lnacimiento IN VARCHAR2);
END;
CREATE OR REPLACE PACKAGE BODY genera_claves AS
FUNCTION consonantes (elipa VARCHAR2 , elima VARCHAR2 , elino VARCHAR2 ) RETURN VARCHAR2 IS
vocal VARCHAR2(5);
letra2 NUMBER(3);
luno VARCHAR2(1);
ldos VARCHAR2(1);
ltres VARCHAR2(1);
lcua VARCHAR2(1);
BEGIN
vocal := 'AEIOU';
IF LENGTH(elipa) > 2 AND LENGTH(elima) > 2 THEN
FOR letra1 IN 2..LENGTH(elipa) LOOP
IF INSTR(vocal, SUBSTR(elipa, letra1, 1) ) = 0 THEN
luno := SUBSTR(elipa, letra1, 1);
EXIT;
END IF;
END LOOP;
FOR letra1 IN 2..LENGTH(elima) LOOP
IF INSTR(vocal, SUBSTR(elima, letra1, 1) ) = 0 THEN
ldos := SUBSTR(elima, letra1, 1);
EXIT;
END IF;
END LOOP;
FOR letra1 IN 2..LENGTH(elino) LOOP
IF INSTR(vocal, SUBSTR(elino, letra1, 1) ) = 0 THEN
ltres := SUBSTR(elino, letra1, 1);
EXIT;
END IF;
END LOOP;
END IF;
return (luno||ldos||ltres);
END;
FUNCTION elimina( nombre VARCHAR2) RETURN VARCHAR2 IS
/*PARAMETERS NOMBRE
*ENTRADA ---> NOMBRE NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE */
nombre1 VARCHAR2(240);
longitud NUMBER;
lx NUMBER;
laux NUMBER;
lnvonombre VARCHAR2(240);
ltemp VARCHAR2(240);
sin_nom VARCHAR2(240);
BEGIN
nombre1 := nombre;
longitud := LENGTH(nombre1);
lx := 1;
lnvonombre := '';
ltemp := '';
LOOP
IF INSTR(nombre1, ' ') > 0 THEN
ltemp := '';
laux := INSTR(nombre1, ' ');
ltemp := SUBSTR(nombre1, 1, laux - 1);
nombre1 := SUBSTR(nombre1,laux + 1,(longitud - LENGTH(ltemp) ) - 1); -- FORMA EL NVO NOMBRE
IF ltemp IN('DE' ,'DEL' ,'LA' ,'LOS' ,'LAS' ,'Y' ,'MC' ,'MAC' ,'VON' ,'VAN') THEN
lx := lx + (LENGTH(ltemp) + 1);
IF lx = longitud THEN
lnvonombre := nombre1;
END IF;
ELSE
lx := lx + LENGTH(ltemp);
lnvonombre := lnvonombre || ltemp || ' ';
END IF;
ELSE
IF lx = 1 THEN
lnvonombre := nombre1;
lx := longitud;
ELSE
lnvonombre := lnvonombre || nombre1;
lx := lx + LENGTH(nombre1);
END IF;
END IF;
EXIT WHEN lx >= longitud;
END LOOP;
sin_nom := RTRIM(LTRIM(lnvonombre) );
RETURN (sin_nom);
END;
FUNCTION caranom(nombre IN VARCHAR2) RETURN VARCHAR2 IS
/*ENTRADA ---> NAME NOMBRE DE LA PERSONA UNO O DOS NOMBRE
*SALIDA ---> INICIAL CARACTER DEL PRIMER NOMBRE*/
nombre1 VARCHAR2(240);
inicial VARCHAR2(240);
ltemp VARCHAR2(240);
laux NUMBER;
BEGIN
nombre1 := nombre;
IF (nombre1 = 'JOSE' AND LENGTH(nombre1) = 4)
OR (nombre1 = 'MARIA' AND LENGTH(nombre1) = 5) THEN
inicial := SUBSTR(nombre1, 1, 1); --- EL NOMBRE ES SOLO MARIA O JOSE
ELSE
IF INSTR(nombre1, ' ') = 0 THEN
inicial := SUBSTR(nombre1, 1, 1); --- EL NOMBRE NO ES COMPUESTO Y NO ES MARIA O JOSE
ELSE
IF INSTR(nombre1, ' ') > 0 THEN
ltemp := ' ';
laux := INSTR(nombre1, ' ');
ltemp := SUBSTR(nombre1, 1, laux - 1);
IF ltemp IN('MARIA', 'JOSE', 'J', 'MA') THEN
inicial := SUBSTR(nombre1, laux + 1, 1); ---- EL NOMBRE INICIAL ES JOSE O MARIA
ELSE
inicial := SUBSTR(nombre1, 1, 1); ---- EL NOMBRE ES COMPUESTO Y NO ES MARIA O JOSE
END IF;
END IF;
END IF;
END IF;
RETURN inicial;
END;
FUNCTION genera_rfc( apaterno VARCHAR2 ,amaterno VARCHAR2 ,nombres VARCHAR2 ,fecha DATE) RETURN VARCHAR2 IS
/*
PARAMETERS PATERNO, MATERNO, NOMBRE, FECHA, RFC, LOGOKARF
*ENTRADA---> PATERNO APELLIDO
* MATERNO '
* NOMBRE NOMBRE(S)
* FECHANAC FECHA DE NACIMIENTO
*SALIDA ---> RFC RFC DE LA PERSONA CON HOMONIMIA Y DIGITO VERIFICADOR
* ---> LOGOKARFC .T. SE GENERA RFC */
TYPE charlist IS TABLE OF VARCHAR2(2000);
anex11 charlist;
anex12 charlist;
anex21 charlist;
anex22 charlist;
anex31 charlist;
anex32 charlist;
valores VARCHAR2(100);
unok VARCHAR2(1000);
van NUMBER;
x1 NUMBER := 1;
sumas NUMBER;
zumas NUMBER;
zumass VARCHAR2(100);
solotres NUMBER;
cociente NUMBER;
residuo NUMBER;
wrok VARCHAR2(1000);
homo VARCHAR2(100);
wbase VARCHAR2(2000);
longi NUMBER;
wrfc VARCHAR2(2000);
x NUMBER := 1;
two NUMBER;
longit NUMBER;
valor VARCHAR2(2);
palabras VARCHAR2(2000);
vocal VARCHAR2(5);
elipa VARCHAR2(1000);
elima VARCHAR2(1000);
elino VARCHAR2(1000);
laux VARCHAR2(1000);
luno VARCHAR2(1000);
ldos VARCHAR2(1000);
ltres VARCHAR2(1000);
lcua VARCHAR2(1000);
letra1 NUMBER;
lrfc1 VARCHAR2(12);
lrfc2 VARCHAR2(13);
lmes VARCHAR2(2);
ldia VARCHAR2(2);
lano VARCHAR2(2);
lnom VARCHAR2(1000);
lcadena VARCHAR2(10);
lsuma NUMBER;
ltrece NUMBER;
i NUMBER;
j NUMBER;
lrfcx1 VARCHAR2(15);
ldigito VARCHAR2(2);
prod1 NUMBER;
prod2 NUMBER;
prod3 NUMBER;
rfc VARCHAR2(15);
entrer NUMBER;
BEGIN
IF LENGTH(apaterno) = 0 AND LENGTH(amaterno) = 0 THEN
RETURN (' SIN APELLIDOS ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF fecha IS NULL THEN
RETURN (' SIN FECHA ');
END IF;
palabras := 'BUEI/CACA/CAGA/CAKA/COGE/COJE/COJO/FETO/JOTO/KACO/KAGO/KOJO/KULO/LOCO/LOKO/MAMO/MEAS/MION/MULA'
|| 'BUEY/CACO/CAGO/CAKO/COJA/COJI/CULO/GUEY/KACA/KAGA/KOGE/KAKA/LOCA/LOKA/MAME/MEAR/MEON/MOCO/PEDA'
|| 'PEDO/PUTA/QULO RUIN/PENE/PUTO/RATA';
vocal := 'AEIOU';
anex11 := charList('*','0','1','2','3','4','5','6','7','8','9','&','\','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z');
anex12 := charList('00','00','01','02','03','04','05','06','07','08','09','10','10','11','12','13','14','15','16','17','18','19','21','22','23','24','25','26','27','28','29','32','33','34','35','36','37','38','39');
anex21 := charList('00','01','02','03','04','05','06','07','08','09','10','11','12','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31','32','33');
anex22 := charList('1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K','L','M','N','P','Q','R','S','T','U','V','W','X','Y','Z');
anex31 := charList('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K','L','M','N','&','O','P','Q','R','S','T','U','V','W','X','Y','Z','*');
anex32 := charList('00','01','02','03','04','05','06','07','08','09','10','11','12','13','14','15','16','17','18','19','20','21','22','23','24','25','26','27','28','29','30','31','32','33','34','35','36','37');
elipa := apaterno;
elima := amaterno;
elino := nombres;
elipa := genera_claves.elimina(apaterno);
elima := genera_claves.elimina(amaterno);
elino := genera_claves.elimina(nombres);
luno := '';
ldos := '';
ltres := '';
lcua := '';
elino := genera_claves.caranom(elino);
IF LENGTH(elipa) > 2 AND LENGTH(elima) > 2 THEN
letra1 := 2;
LOOP
IF INSTR(vocal, SUBSTR(elipa, letra1, 1) ) > 0 THEN
ldos := SUBSTR( vocal ,INSTR(vocal, SUBSTR(elipa, letra1, 1) ) ,1);
EXIT;
END IF;
letra1 := letra1 + 1;
EXIT WHEN letra1 > LENGTH(elipa);
END LOOP;
luno := SUBSTR(elipa, 1, 1);
ltres := SUBSTR(elima, 1, 1);
lcua := SUBSTR(elino, 1, 1);
ELSIF (LENGTH(elipa) > 0 AND LENGTH(elipa) <= 2) AND LENGTH(elima) > 0 THEN
luno := SUBSTR(elipa, 1, 1);
ltres := SUBSTR(elima, 1, 1);
lcua := SUBSTR(elino, 1, 2);
ELSIF LENGTH(TRIM(elipa) ) = 0 AND LENGTH(TRIM(elima) ) > 0 THEN
ldos := SUBSTR(elima, 1, 2);
lcua := SUBSTR(elino, 1, 1);
ELSIF LENGTH(TRIM(elipa) ) > 0 AND LENGTH(TRIM(elima) ) = 0 THEN
luno := SUBSTR(elipa, 1, 2);
lcua := SUBSTR(elino, 1, 1);
END IF;
lrfc1 := luno || ldos || ltres || lcua;
lmes := LPAD(TO_CHAR(fecha, 'MM'), 2, 0);
ldia := LPAD(TO_CHAR(fecha, 'DD'), 2, 0);
lano := LPAD(TO_CHAR(fecha, 'YY'), 2, 0);
lrfc2 := lano || lmes || ldia;
IF INSTR(palabras, lrfc1) > 0 THEN
lrfc1 := SUBSTR(lrfc1, 1, 3) || 'X';
END IF;
lnom := TRIM(apaterno) || ' ' || TRIM(amaterno) || ' ' || TRIM(nombres);
lcadena := '0';
-- longitud := LENGTH(lnom);
valores := '0';
wbase := LTRIM( LTRIM(apaterno) || ' ' || LTRIM(amaterno) || ' ' || LTRIM( nombres) );
FOR x IN 1 .. LENGTH(wbase) LOOP
unok := SUBSTR(wbase, x, 1);
IF (unok = ' ') THEN
unok := '*';
END IF;
x1 := 1;
LOOP
IF anex11(x1) = unok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF (van > 0) THEN
valores := valores || anex12(van);
ELSE
valores := valores || '00';
END IF;
END LOOP;
sumas := 0;
FOR x IN 1 .. LENGTH(valores) - 1 LOOP
prod1 := TO_NUMBER(SUBSTR(valores, x, 2) );
prod2 := TO_NUMBER(SUBSTR(valores, x + 1, 1) );
prod3 := prod1 * prod2;
sumas := sumas + prod3;
END LOOP;
zumass := TO_CHAR(sumas);
--- zumass := right(zumass, 3);
longi := LENGTH(zumass) - 2;
zumass := SUBSTR(zumass, LENGTH(zumass) - 2, 3);
zumas := TO_NUMBER(zumass);
solotres := zumas;
cociente := TRUNC(solotres / 34, 0);
residuo := MOD(solotres, 34);
IF (cociente < 10) THEN
wrok := '0' + TO_CHAR(cociente, 1);
ELSE
wrok := TO_CHAR(cociente);
END IF;
x1 := 1;
LOOP
IF anex21(x1) = wrok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF (van > 0) THEN
homo := anex22(van);
ELSE
homo := '1';
END IF;
IF (residuo < 10) THEN
wrok := '0' + TO_CHAR(residuo);
ELSE
wrok := TO_CHAR(residuo);
END IF;
x1 := 1;
LOOP
IF anex21(x1) = wrok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF (van > 0) THEN
homo := homo || anex22(van);
ELSE
homo := homo || '1';
END IF;
lrfcx1 := lrfc1 || lrfc2 || homo;
valores := '';
FOR x IN 1 .. LENGTH(lrfcx1) LOOP
unok := SUBSTR(lrfcx1, x, 1);
IF unok = ' ' THEN
unok := '*';
END IF;
x1 := 1;
LOOP
IF anex31(x1) = unok THEN
van := x1;
EXIT;
END IF;
x1 := x1 + 1;
END LOOP;
IF van > 0 THEN
valores := valores || anex32(van);
ELSE
valores := valores || '00';
END IF;
END LOOP;
sumas := 0;
ltrece := 13;
FOR x IN 1 .. 12 LOOP
prod1 := TO_NUMBER(SUBSTR(valores, x * 2 - 1, 2) );
prod3 := prod1 * ltrece;
sumas := sumas + prod3;
ltrece := ltrece - 1;
END LOOP;
cociente := TRUNC(sumas / 11, 0);
residuo := MOD(sumas, 11);
IF residuo = 0 THEN
ldigito := '0';
ELSE
valor := 11 - residuo;
IF (valor = 10) THEN
ldigito := 'A';
ELSE
entrer := TO_CHAR(valor);
ldigito := SUBSTR(entrer, 1, 1);
--- right(entrer, 1);
END IF;
END IF;
rfc := lrfcx1 || LTRIM(ldigito);
RETURN (rfc);
END;
FUNCTION genera_curp(apaterno VARCHAR2
,amaterno VARCHAR2
,nombres VARCHAR2
,fecha DATE
,sexo VARCHAR2
,lnacimiento VARCHAR2) RETURN VARCHAR2 IS
PRIMERA VARCHAR2(10);
CONSONANTES VARCHAR2(3);
DIGITO1 VARCHAR2(1);
DIGITO2 VARCHAR2(1);
CURP VARCHAR2(18);
BEGIN
IF LENGTH(apaterno) = 0 AND LENGTH(amaterno) = 0 THEN
RETURN (' SIN APELLIDOS ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF LENGTH(nombres) = 0 THEN
RETURN (' SIN NOMBRE ');
ELSIF fecha IS NULL THEN
RETURN (' SIN FECHA ');
END IF;
PRIMERA := substr(genera_claves.genera_rfc (apaterno, amaterno, nombres, fecha),1,10);
DIGITO2 := substr(genera_claves.genera_rfc (apaterno, amaterno, nombres, fecha),13,1);
CONSONANTES := genera_claves.consonantes (apaterno, amaterno, nombres);
IF TO_CHAR(FECHA,'YYYY') < 2000 THEN
DIGITO1 := 0;
ELSE
DIGITO1 := 1;
END IF;
/* El sexo es H Hombre, M Mujer */
/* Las claves de Estado son
AGUASCALIENTES AS MORELOS MS
BAJA CALIFORNIA BC NAYARIT NT
BAJA CALIFORNIA SUR BS NUEVO LEON NL
CAMPECHE CC OAXACA OC
CHIAPAS CS PUEBLA PL
CHIHUAHUA CH QUERETARO QT
COAHUILA CL QUINTANA ROO QR
COLIMA CM SAN LUIS POTOSI SP
DISTRITO FEDERAL DF SINALOA SL
DURANGO DG SONORA SR
GUANAJUATO GT TABASCO TC
GUERRERO GR TAMAULIPAS TS
HIDALGO HG TLAXCALA TL
JALISCO JC VERACRUZ VZ
MEXICO MC YUCATÁN YN
MICHOACAN MN ZACATECAS ZS
NE para los extranjeros */
CURP := PRIMERA||SEXO||LNACIMIENTO||CONSONANTES||DIGITO1||DIGITO2;
RETURN (CURP);
END;
FUNCTION genera_imss (fecha_nac DATE, fecha_ing DATE) RETURN VARCHAR2 IS
clave VARCHAR2(11);
BEGIN
clave := '12345678901';
---to_char(fecha_nac,'YY')||to_char(fecha_ing,'YY');
RETURN (clave);
END;
PROCEDURE genera_claves (
errbuf OUT VARCHAR2
,retcode OUT VARCHAR2
,rfc OUT VARCHAR2
,curp OUT VARCHAR2
,imss OUT VARCHAR2
,apaterno IN VARCHAR2
,amaterno IN VARCHAR2
,nombres IN VARCHAR2
,fecha IN DATE
,fecha_ing IN DATE
,sexo IN VARCHAR2
,lnacimiento IN VARCHAR2) IS
BEGIN
rfc := substr(genera_claves.genera_rfc (apaterno, amaterno, nombres, fecha),1,13);
curp := substr(genera_claves.genera_curp (apaterno, amaterno, nombres, fecha, sexo, lnacimiento),1,18);
imss := substr(genera_claves.genera_imss (fecha, fecha_ing),1,11);
END;
END;
TENGO UN PROGRAMA PARA CALCULAR MANDAME TU CORREO, PERO NECESITO TU APALLIDO PATERNO, MATERNO, 1er. NOMBRE Y NOMBRES.
LUEGO TE LO MANDO.
LUEGO TE LO MANDO.
¡¡¡Atencion Programadores!!!
¡¡¡Ofrezco el código en VisualBASIC o CLIPPER!!!
Costo 40 Dlls.
Comunicarse al e-mail:
[email protected]
¡¡¡Ofrezco el código en VisualBASIC o CLIPPER!!!
Costo 40 Dlls.
Comunicarse al e-mail:
[email protected]
Les envio el codigo para personas fisicas, lo unico que no tengo es como calcular el digito verificador de personas morales, si alguien sabe como se obtiene se los agradeceria.
CREATE PROC SP_CALCULA_RFC
@NOMBRES_AUX VARCHAR(100),
@APATERNO_AUX VARCHAR(100),
@AMATERNO_AUX VARCHAR(100),
@FECHANACIMIENTO DATETIME,
@RFC_OUT CHAR(16) OUT
AS
--DECLARACION DE VARIABLES
DECLARE @NOMBRES VARCHAR(100)
DECLARE @APATERNO VARCHAR(100)
DECLARE @AMATERNO VARCHAR(100)
DECLARE @T_NOMTOT CHAR(52)
DECLARE @NOMBRE1 VARCHAR(100) --PRIMER NOMBRE
DECLARE @NOMBRE2 VARCHAR(100) --DEMAS NOMBRES
DECLARE @NOMBRES_LONGITUD INT --LONGITUD DE TODOS @NOMBRES
DECLARE @NOMBRE1_LONGITUD INT --LONGITUD DEL PRIMER NOMBRE(MAS UNO,EL QUE SOBRA ES UN ESPACIO EN BLANCO)
DECLARE @APATERNO1 VARCHAR(100) --PRIMER NOMBRE
DECLARE @APATERNO2 VARCHAR(100) --DEMAS NOMBRES
DECLARE @APATERNO_LONGITUD INT --LONGITUD DE TODOS @NOMBRES
DECLARE @APATERNO1_LONGITUD INT --LONGITUD DEL PRIMER NOMBRE(MAS UNO,EL QUE SOBRA ES UN ESPACIO EN BLANCO)
DECLARE @AMATERNO1 VARCHAR(100) --PRIMER NOMBRE
DECLARE @AMATERNO2 VARCHAR(100) --DEMAS NOMBRES
DECLARE @AMATERNO_LONGITUD INT --LONGITUD DE TODOS @NOMBRES
DECLARE @AMATERNO1_LONGITUD INT --LONGITUD DEL PRIMER NOMBRE(MAS UNO,EL QUE SOBRA ES UN ESPACIO EN BLANCO)
DECLARE @VARLOOPS INT --VARIABLE PARA LOS LOOPS, SE INICIALIZA AL INICIR UN LOOP
DECLARE @RFC CHAR(16)
DECLARE @T_NOMNUM CHAR(102) --Nombre numerico
DECLARE @T_SUMA INT
DECLARE @T_DIVID INT -- Dividendo
DECLARE @T_MOD INT -- MOD de la division
DECLARE @T_HOMOCLV CHAR(3) -- Homoclave
DECLARE @T_NUMERO INT -- Numero ASC asignado a un caracter
DECLARE @T_PARCIAL INT -- Acumulado de la suma de los caracteres del RFC
--INICIALZA VARIABLES
SET @NOMBRES = LTRIM(RTRIM(@NOMBRES_AUX))
SET @APATERNO = LTRIM(RTRIM(@APATERNO_AUX))
SET @AMATERNO = LTRIM(RTRIM(@AMATERNO_AUX))
SET @T_NOMTOT =@APATERNO+' '+@AMATERNO+' '+@NOMBRES
--PROCESAR NOMBRES DE PILA
SET @VARLOOPS = 0
WHILE @VARLOOPS <> 1
BEGIN
SET @NOMBRES_LONGITUD = LEN(@NOMBRES)
SET @NOMBRE1_LONGITUD = PATINDEX('% %',@NOMBRES)
IF @NOMBRE1_LONGITUD = 0
SET @NOMBRE1_LONGITUD = @NOMBRES_LONGITUD
SET @NOMBRE1 = RTRIM(LEFT(@NOMBRES,@NOMBRE1_LONGITUD))
SET @NOMBRE2 = LTRIM(RIGHT(@NOMBRES,@NOMBRES_LONGITUD - @NOMBRE1_LONGITUD))
--SE QUINTAN LOS NOMBRES DE JOSE, MARIA,MA,MA.
IF @NOMBRE1 IN ('JOSE','MARIA','MA.','MA','DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN') AND @NOMBRE2 <> ''
BEGIN
SET @NOMBRES = @NOMBRE2
END
ELSE
BEGIN
SET @VARLOOPS = 1
END
END
--PROCESAMOS APELLIDOS, PATERNO EN UN LOOP
SET @VARLOOPS = 0
WHILE @VARLOOPS <> 1
BEGIN
SET @APATERNO_LONGITUD = LEN(@APATERNO)
SET @APATERNO1_LONGITUD = PATINDEX('% %',@APATERNO)
IF @APATERNO1_LONGITUD = 0
SET @APATERNO1_LONGITUD = @APATERNO_LONGITUD
SET @APATERNO1 = RTRIM(LEFT(@APATERNO,@APATERNO1_LONGITUD))
SET @APATERNO2 = LTRIM(RIGHT(@APATERNO,@APATERNO_LONGITUD - @APATERNO1_LONGITUD))
--SE QUINTAN LOS SUFIJOS
IF @APATERNO1 IN ('DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN') AND @APATERNO2 <> ''
BEGIN
SET @APATERNO = @APATERNO2
END
ELSE
BEGIN
SET @VARLOOPS = 1
END
END
--PROCESAMOS APELLIDOS, MATERNO EN UN LOOP
SET @VARLOOPS = 0
WHILE @VARLOOPS <> 1
BEGIN
SET @AMATERNO_LONGITUD = LEN(@AMATERNO)
SET @AMATERNO1_LONGITUD = PATINDEX('% %',@AMATERNO)
IF @AMATERNO1_LONGITUD = 0
SET @AMATERNO1_LONGITUD = @AMATERNO_LONGITUD
SET @AMATERNO1 = RTRIM(LEFT(@AMATERNO,@AMATERNO1_LONGITUD))
SET @AMATERNO2 = LTRIM(RIGHT(@AMATERNO,@AMATERNO_LONGITUD - @AMATERNO1_LONGITUD))
--SE QUINTAN LOS SUFIJOS
IF @AMATERNO1 IN ('DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN') AND @AMATERNO2 <> ''
BEGIN
SET @AMATERNO = @AMATERNO2
END
ELSE
BEGIN
SET @VARLOOPS = 1
END
END
--SE OBTIENE DEL PRIMER APELLIDO LA PRIMER LETRA Y LA PRIMER VOCAL INTERNA
SET @RFC = LEFT(@APATERNO1,1)
SET @APATERNO1_LONGITUD= LEN(@APATERNO1)
SET @VARLOOPS = 1 --EMPIEZA EN UNO POR LA PRIMERA LETRA SE LA VA A SALTAR
WHILE @APATERNO1_LONGITUD > @VARLOOPS
BEGIN
SET @VARLOOPS = @VARLOOPS + 1
IF SUBSTRING(@APATERNO1,@VARLOOPS,1) IN ('A','E','I','O','U')
BEGIN
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@APATERNO1,@VARLOOPS,1))
SET @VARLOOPS = @APATERNO1_LONGITUD
END
END
--SE OBTIENE LA PRIMER LETRA DEL APELLIDO MATERNO SI NO TIENE APELLIDO MATERNO SE PONE UNA X
--DICE QUE SI NO TIENE APELLIDO MATERNO LE PONGAS LA PRIMER LETRA DEL APELLIDO PATERNO EN EL RFX
IF ISNULL(@AMATERNO1,'') = ''
BEGIN
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@APATERNO1,1,1))
END
ELSE
BEGIN
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@AMATERNO1,1,1))
END
--SE LE AGREGA LA PRIMER LETRA DEL NOMBRE
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@NOMBRE1,1,1))
--CHEAS QUE NO SEA UNA PALARA INCONVENIENTE
IF EXISTS ( SELECT INC_PALINC FROM NINCO WHERE INC_PALINC = @RFC )
BEGIN
SELECT @RFC = LTRIM(RTRIM (SUBSTRING (@RFC , 1 , 3))) + 'X'
END
--SE LE AGREGA LA FECHA DE NACIMIENTO
SET @RFC = RTRIM(@RFC) + CONVERT(CHAR,@FECHANACIMIENTO,12)
--HOMOCLAVE
SET @T_NOMNUM = '0'
--SACA NOMBRE NUMERICO
SET @VARLOOPS = 1
WHILE @VARLOOPS <= 52
BEGIN
SET @T_NOMNUM = LTRIM(RTRIM (@T_NOMNUM)) +
CASE
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS, 1) = 'A' THEN '11'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'B' THEN '12'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'C' THEN '13'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'D' THEN '14'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'E' THEN '15'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'F' THEN '16'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'G' THEN '17'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'H' THEN '18'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'I' THEN '19'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'J' THEN '21'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'K' THEN '22'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'L' THEN '23'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'M' THEN '24'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'N' THEN '25'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'O' THEN '26'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'P' THEN '27'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'Q' THEN '28'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'R' THEN '29'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'S' THEN '32'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'T' THEN '33'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'U' THEN '34'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'V' THEN '35'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'W' THEN '36'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'X' THEN '37'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'Y' THEN '38'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'Z' THEN '39'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) >= '0' AND
SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) <= '9' THEN CONVERT(VARCHAR,CONVERT(INT, SUBSTRING (@T_NOMTOT , @VARLOOPS , 1)) , 2)
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) IN ('&','Ñ') THEN '10'
ELSE '00'
END
SET @VARLOOPS = @VARLOOPS + 1
END
set @VARLOOPS = 1
SET @T_SUMA = 0
while @VARLOOPS <= 99
begin
SET @T_SUMA = @T_SUMA + ((CONVERT(INT,SUBSTRING (@T_NOMNUM , @VARLOOPS , 1))*10) + CONVERT(INT,SUBSTRING (@T_NOMNUM , @VARLOOPS+1 , 1))) * CONVERT(INT,SUBSTRING (@T_NOMNUM , @VARLOOPS+1 , 1))
SET @VARLOOPS = @VARLOOPS + 1
end
-- Obtener HOMOCLAVE
SELECT @T_DIVID = @T_SUMA%1000 -- Obtener residuo de los ultimos 3 digitos
SELECT @T_MOD = @T_DIVID%34 -- Obtener el residuo de los ultimos 3 digitos-- entre 34
SELECT @T_DIVID = (@T_DIVID - @T_MOD) / 34 -- Obtener el Cociente entero
--select @T_DIVID,@T_MOD
-- Checar Cociente y residuo
SET @VARLOOPS = 0
WHILE @VARLOOPS <= 1
BEGIN
SET @T_HOMOCLV =
CASE CASE @VARLOOPS WHEN 0 THEN @T_DIVID ELSE @T_MOD END
WHEN 0 THEN '1'
WHEN 1 THEN '2'
WHEN 2 THEN '3'
WHEN 3 THEN '4'
WHEN 4 THEN '5'
WHEN 5 THEN '6'
WHEN 6 THEN '7'
WHEN 7 THEN '8'
WHEN 8 THEN '9'
WHEN 9 THEN 'A'
WHEN 10 THEN 'B'
WHEN 11 THEN 'C'
WHEN 12 THEN 'D'
WHEN 13 THEN 'E'
WHEN 14 THEN 'F'
WHEN 15 THEN 'G'
WHEN 16 THEN 'H'
WHEN 17 THEN 'I'
WHEN 18 THEN 'J'
WHEN 19 THEN 'K'
WHEN 20 THEN 'L'
WHEN 21 THEN 'M'
WHEN 22 THEN 'N'
WHEN 23 THEN 'P'
WHEN 24 THEN 'Q'
WHEN 25 THEN 'R'
WHEN 26 THEN 'S'
WHEN 27 THEN 'T'
WHEN 28 THEN 'U'
WHEN 29 THEN 'V'
WHEN 30 THEN 'W'
WHEN 31 THEN 'X'
WHEN 32 THEN 'Y'
ELSE 'Z'
END
SET @VARLOOPS = @VARLOOPS + 1
-- Incluir la parte de la homoclave
SET @RFC = LTRIM(RTRIM (@RFC)) + LTRIM(RTRIM (@T_HOMOCLV))
END
-- ---------------------------------------------
-- Obtener Digito Verificador
-- ---------------------------------------------
SET @VARLOOPS = 0
SET @T_PARCIAL = 0
WHILE @VARLOOPS < 12
BEGIN
SELECT @VARLOOPS = @VARLOOPS + 1
SET @T_NUMERO =
CASE
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'A' THEN 10
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'B' THEN 11
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'C' THEN 12
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'D' THEN 13
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'E' THEN 14
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'F' THEN 15
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'G' THEN 16
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'H' THEN 17
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'I' THEN 18
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'J' THEN 19
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'K' THEN 20
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'L' THEN 21
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'M' THEN 22
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'N' THEN 23
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'O' THEN 25
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'P' THEN 26
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'Q' THEN 27
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'R' THEN 28
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'S' THEN 29
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'T' THEN 30
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'U' THEN 31
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'V' THEN 32
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'W' THEN 33
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'X' THEN 34
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'Y' THEN 35
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'Z' THEN 36
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) >= '0' AND
SUBSTRING (@RFC , @VARLOOPS , 1) <= '9'
THEN CONVERT(INT,SUBSTRING (@RFC , @VARLOOPS , 1))
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = ''
THEN 24
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = ' '
THEN 37
ELSE 0
END
-- Contabilizar el nuevo digito
SELECT @T_PARCIAL = @T_PARCIAL + (@T_NUMERO * (14 - @VARLOOPS))
END
SET @T_MOD = ROUND(@T_PARCIAL%11,1)
IF @T_MOD = 0
SET @RFC = LTRIM(RTRIM (@RFC)) + '0'
ELSE
BEGIN
SET @T_PARCIAL = 11 - @T_MOD
IF @T_PARCIAL = 10
SELECT @RFC = LTRIM(RTRIM (@RFC)) + 'A'
ELSE
SELECT @RFC = LTRIM(RTRIM (@RFC)) + CONVERT(VARCHAR ,@T_PARCIAL)
END
--SELECT @T_NOMTOT,@T_SUMA
SET @RFC_OUT = @RFC
SELECT @RFC AS 'RFC'
CREATE PROC SP_CALCULA_RFC
@NOMBRES_AUX VARCHAR(100),
@APATERNO_AUX VARCHAR(100),
@AMATERNO_AUX VARCHAR(100),
@FECHANACIMIENTO DATETIME,
@RFC_OUT CHAR(16) OUT
AS
--DECLARACION DE VARIABLES
DECLARE @NOMBRES VARCHAR(100)
DECLARE @APATERNO VARCHAR(100)
DECLARE @AMATERNO VARCHAR(100)
DECLARE @T_NOMTOT CHAR(52)
DECLARE @NOMBRE1 VARCHAR(100) --PRIMER NOMBRE
DECLARE @NOMBRE2 VARCHAR(100) --DEMAS NOMBRES
DECLARE @NOMBRES_LONGITUD INT --LONGITUD DE TODOS @NOMBRES
DECLARE @NOMBRE1_LONGITUD INT --LONGITUD DEL PRIMER NOMBRE(MAS UNO,EL QUE SOBRA ES UN ESPACIO EN BLANCO)
DECLARE @APATERNO1 VARCHAR(100) --PRIMER NOMBRE
DECLARE @APATERNO2 VARCHAR(100) --DEMAS NOMBRES
DECLARE @APATERNO_LONGITUD INT --LONGITUD DE TODOS @NOMBRES
DECLARE @APATERNO1_LONGITUD INT --LONGITUD DEL PRIMER NOMBRE(MAS UNO,EL QUE SOBRA ES UN ESPACIO EN BLANCO)
DECLARE @AMATERNO1 VARCHAR(100) --PRIMER NOMBRE
DECLARE @AMATERNO2 VARCHAR(100) --DEMAS NOMBRES
DECLARE @AMATERNO_LONGITUD INT --LONGITUD DE TODOS @NOMBRES
DECLARE @AMATERNO1_LONGITUD INT --LONGITUD DEL PRIMER NOMBRE(MAS UNO,EL QUE SOBRA ES UN ESPACIO EN BLANCO)
DECLARE @VARLOOPS INT --VARIABLE PARA LOS LOOPS, SE INICIALIZA AL INICIR UN LOOP
DECLARE @RFC CHAR(16)
DECLARE @T_NOMNUM CHAR(102) --Nombre numerico
DECLARE @T_SUMA INT
DECLARE @T_DIVID INT -- Dividendo
DECLARE @T_MOD INT -- MOD de la division
DECLARE @T_HOMOCLV CHAR(3) -- Homoclave
DECLARE @T_NUMERO INT -- Numero ASC asignado a un caracter
DECLARE @T_PARCIAL INT -- Acumulado de la suma de los caracteres del RFC
--INICIALZA VARIABLES
SET @NOMBRES = LTRIM(RTRIM(@NOMBRES_AUX))
SET @APATERNO = LTRIM(RTRIM(@APATERNO_AUX))
SET @AMATERNO = LTRIM(RTRIM(@AMATERNO_AUX))
SET @T_NOMTOT =@APATERNO+' '+@AMATERNO+' '+@NOMBRES
--PROCESAR NOMBRES DE PILA
SET @VARLOOPS = 0
WHILE @VARLOOPS <> 1
BEGIN
SET @NOMBRES_LONGITUD = LEN(@NOMBRES)
SET @NOMBRE1_LONGITUD = PATINDEX('% %',@NOMBRES)
IF @NOMBRE1_LONGITUD = 0
SET @NOMBRE1_LONGITUD = @NOMBRES_LONGITUD
SET @NOMBRE1 = RTRIM(LEFT(@NOMBRES,@NOMBRE1_LONGITUD))
SET @NOMBRE2 = LTRIM(RIGHT(@NOMBRES,@NOMBRES_LONGITUD - @NOMBRE1_LONGITUD))
--SE QUINTAN LOS NOMBRES DE JOSE, MARIA,MA,MA.
IF @NOMBRE1 IN ('JOSE','MARIA','MA.','MA','DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN') AND @NOMBRE2 <> ''
BEGIN
SET @NOMBRES = @NOMBRE2
END
ELSE
BEGIN
SET @VARLOOPS = 1
END
END
--PROCESAMOS APELLIDOS, PATERNO EN UN LOOP
SET @VARLOOPS = 0
WHILE @VARLOOPS <> 1
BEGIN
SET @APATERNO_LONGITUD = LEN(@APATERNO)
SET @APATERNO1_LONGITUD = PATINDEX('% %',@APATERNO)
IF @APATERNO1_LONGITUD = 0
SET @APATERNO1_LONGITUD = @APATERNO_LONGITUD
SET @APATERNO1 = RTRIM(LEFT(@APATERNO,@APATERNO1_LONGITUD))
SET @APATERNO2 = LTRIM(RIGHT(@APATERNO,@APATERNO_LONGITUD - @APATERNO1_LONGITUD))
--SE QUINTAN LOS SUFIJOS
IF @APATERNO1 IN ('DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN') AND @APATERNO2 <> ''
BEGIN
SET @APATERNO = @APATERNO2
END
ELSE
BEGIN
SET @VARLOOPS = 1
END
END
--PROCESAMOS APELLIDOS, MATERNO EN UN LOOP
SET @VARLOOPS = 0
WHILE @VARLOOPS <> 1
BEGIN
SET @AMATERNO_LONGITUD = LEN(@AMATERNO)
SET @AMATERNO1_LONGITUD = PATINDEX('% %',@AMATERNO)
IF @AMATERNO1_LONGITUD = 0
SET @AMATERNO1_LONGITUD = @AMATERNO_LONGITUD
SET @AMATERNO1 = RTRIM(LEFT(@AMATERNO,@AMATERNO1_LONGITUD))
SET @AMATERNO2 = LTRIM(RIGHT(@AMATERNO,@AMATERNO_LONGITUD - @AMATERNO1_LONGITUD))
--SE QUINTAN LOS SUFIJOS
IF @AMATERNO1 IN ('DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN') AND @AMATERNO2 <> ''
BEGIN
SET @AMATERNO = @AMATERNO2
END
ELSE
BEGIN
SET @VARLOOPS = 1
END
END
--SE OBTIENE DEL PRIMER APELLIDO LA PRIMER LETRA Y LA PRIMER VOCAL INTERNA
SET @RFC = LEFT(@APATERNO1,1)
SET @APATERNO1_LONGITUD= LEN(@APATERNO1)
SET @VARLOOPS = 1 --EMPIEZA EN UNO POR LA PRIMERA LETRA SE LA VA A SALTAR
WHILE @APATERNO1_LONGITUD > @VARLOOPS
BEGIN
SET @VARLOOPS = @VARLOOPS + 1
IF SUBSTRING(@APATERNO1,@VARLOOPS,1) IN ('A','E','I','O','U')
BEGIN
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@APATERNO1,@VARLOOPS,1))
SET @VARLOOPS = @APATERNO1_LONGITUD
END
END
--SE OBTIENE LA PRIMER LETRA DEL APELLIDO MATERNO SI NO TIENE APELLIDO MATERNO SE PONE UNA X
--DICE QUE SI NO TIENE APELLIDO MATERNO LE PONGAS LA PRIMER LETRA DEL APELLIDO PATERNO EN EL RFX
IF ISNULL(@AMATERNO1,'') = ''
BEGIN
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@APATERNO1,1,1))
END
ELSE
BEGIN
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@AMATERNO1,1,1))
END
--SE LE AGREGA LA PRIMER LETRA DEL NOMBRE
SET @RFC = RTRIM(@RFC)+CONVERT(CHAR(1),SUBSTRING(@NOMBRE1,1,1))
--CHEAS QUE NO SEA UNA PALARA INCONVENIENTE
IF EXISTS ( SELECT INC_PALINC FROM NINCO WHERE INC_PALINC = @RFC )
BEGIN
SELECT @RFC = LTRIM(RTRIM (SUBSTRING (@RFC , 1 , 3))) + 'X'
END
--SE LE AGREGA LA FECHA DE NACIMIENTO
SET @RFC = RTRIM(@RFC) + CONVERT(CHAR,@FECHANACIMIENTO,12)
--HOMOCLAVE
SET @T_NOMNUM = '0'
--SACA NOMBRE NUMERICO
SET @VARLOOPS = 1
WHILE @VARLOOPS <= 52
BEGIN
SET @T_NOMNUM = LTRIM(RTRIM (@T_NOMNUM)) +
CASE
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS, 1) = 'A' THEN '11'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'B' THEN '12'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'C' THEN '13'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'D' THEN '14'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'E' THEN '15'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'F' THEN '16'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'G' THEN '17'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'H' THEN '18'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'I' THEN '19'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'J' THEN '21'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'K' THEN '22'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'L' THEN '23'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'M' THEN '24'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'N' THEN '25'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'O' THEN '26'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'P' THEN '27'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'Q' THEN '28'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'R' THEN '29'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'S' THEN '32'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'T' THEN '33'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'U' THEN '34'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'V' THEN '35'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'W' THEN '36'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'X' THEN '37'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'Y' THEN '38'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) = 'Z' THEN '39'
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) >= '0' AND
SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) <= '9' THEN CONVERT(VARCHAR,CONVERT(INT, SUBSTRING (@T_NOMTOT , @VARLOOPS , 1)) , 2)
WHEN SUBSTRING (@T_NOMTOT , @VARLOOPS , 1) IN ('&','Ñ') THEN '10'
ELSE '00'
END
SET @VARLOOPS = @VARLOOPS + 1
END
set @VARLOOPS = 1
SET @T_SUMA = 0
while @VARLOOPS <= 99
begin
SET @T_SUMA = @T_SUMA + ((CONVERT(INT,SUBSTRING (@T_NOMNUM , @VARLOOPS , 1))*10) + CONVERT(INT,SUBSTRING (@T_NOMNUM , @VARLOOPS+1 , 1))) * CONVERT(INT,SUBSTRING (@T_NOMNUM , @VARLOOPS+1 , 1))
SET @VARLOOPS = @VARLOOPS + 1
end
-- Obtener HOMOCLAVE
SELECT @T_DIVID = @T_SUMA%1000 -- Obtener residuo de los ultimos 3 digitos
SELECT @T_MOD = @T_DIVID%34 -- Obtener el residuo de los ultimos 3 digitos-- entre 34
SELECT @T_DIVID = (@T_DIVID - @T_MOD) / 34 -- Obtener el Cociente entero
--select @T_DIVID,@T_MOD
-- Checar Cociente y residuo
SET @VARLOOPS = 0
WHILE @VARLOOPS <= 1
BEGIN
SET @T_HOMOCLV =
CASE CASE @VARLOOPS WHEN 0 THEN @T_DIVID ELSE @T_MOD END
WHEN 0 THEN '1'
WHEN 1 THEN '2'
WHEN 2 THEN '3'
WHEN 3 THEN '4'
WHEN 4 THEN '5'
WHEN 5 THEN '6'
WHEN 6 THEN '7'
WHEN 7 THEN '8'
WHEN 8 THEN '9'
WHEN 9 THEN 'A'
WHEN 10 THEN 'B'
WHEN 11 THEN 'C'
WHEN 12 THEN 'D'
WHEN 13 THEN 'E'
WHEN 14 THEN 'F'
WHEN 15 THEN 'G'
WHEN 16 THEN 'H'
WHEN 17 THEN 'I'
WHEN 18 THEN 'J'
WHEN 19 THEN 'K'
WHEN 20 THEN 'L'
WHEN 21 THEN 'M'
WHEN 22 THEN 'N'
WHEN 23 THEN 'P'
WHEN 24 THEN 'Q'
WHEN 25 THEN 'R'
WHEN 26 THEN 'S'
WHEN 27 THEN 'T'
WHEN 28 THEN 'U'
WHEN 29 THEN 'V'
WHEN 30 THEN 'W'
WHEN 31 THEN 'X'
WHEN 32 THEN 'Y'
ELSE 'Z'
END
SET @VARLOOPS = @VARLOOPS + 1
-- Incluir la parte de la homoclave
SET @RFC = LTRIM(RTRIM (@RFC)) + LTRIM(RTRIM (@T_HOMOCLV))
END
-- ---------------------------------------------
-- Obtener Digito Verificador
-- ---------------------------------------------
SET @VARLOOPS = 0
SET @T_PARCIAL = 0
WHILE @VARLOOPS < 12
BEGIN
SELECT @VARLOOPS = @VARLOOPS + 1
SET @T_NUMERO =
CASE
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'A' THEN 10
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'B' THEN 11
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'C' THEN 12
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'D' THEN 13
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'E' THEN 14
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'F' THEN 15
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'G' THEN 16
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'H' THEN 17
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'I' THEN 18
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'J' THEN 19
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'K' THEN 20
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'L' THEN 21
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'M' THEN 22
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'N' THEN 23
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'O' THEN 25
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'P' THEN 26
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'Q' THEN 27
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'R' THEN 28
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'S' THEN 29
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'T' THEN 30
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'U' THEN 31
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'V' THEN 32
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'W' THEN 33
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'X' THEN 34
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'Y' THEN 35
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = 'Z' THEN 36
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) >= '0' AND
SUBSTRING (@RFC , @VARLOOPS , 1) <= '9'
THEN CONVERT(INT,SUBSTRING (@RFC , @VARLOOPS , 1))
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = ''
THEN 24
WHEN SUBSTRING (@RFC , @VARLOOPS , 1) = ' '
THEN 37
ELSE 0
END
-- Contabilizar el nuevo digito
SELECT @T_PARCIAL = @T_PARCIAL + (@T_NUMERO * (14 - @VARLOOPS))
END
SET @T_MOD = ROUND(@T_PARCIAL%11,1)
IF @T_MOD = 0
SET @RFC = LTRIM(RTRIM (@RFC)) + '0'
ELSE
BEGIN
SET @T_PARCIAL = 11 - @T_MOD
IF @T_PARCIAL = 10
SELECT @RFC = LTRIM(RTRIM (@RFC)) + 'A'
ELSE
SELECT @RFC = LTRIM(RTRIM (@RFC)) + CONVERT(VARCHAR ,@T_PARCIAL)
END
--SELECT @T_NOMTOT,@T_SUMA
SET @RFC_OUT = @RFC
SELECT @RFC AS 'RFC'
Yo estoy buscando el algoritmo para crear CURP completo. se que no puede ser 100% exacto por lo del digito que proporciona la CONAPO... pero solo lo necesito para validacion y tengo que hacer la traduccion a PL/SQL
hola me podias enviar el programa para calcular el curp y la homoclave gracias
Mucho agradeceria me enviaras el programa para calcular la homoclave. gracias
hola mucho te agradeceria si me envias el programa para calcular la homoclave me urge. gracias
si me interesa saber como se saca el homo clave de los trabajadores
Para mx, si es asi lo puedes solicitar el algoritmo en la shcp, si sabes algo de dbase yo lo tengo implementado en este lenguaje si te interesa escribeme.
Hola Malone, te agradeceria mucho me pudieras enviar como obtener el rfc con homoclave......bye
Thelma
Thelma
Hola, por lo que lei creo que tu me puedes ayudar muchisimo, me podrias enviar tu programa,
mil gracias
ME URGE
mil gracias
ME URGE
Yo estaria interesado en verlo en Dbase, podrias enviarmelo?
Desde ya muchas gracias.
Desde ya muchas gracias.
si tienes el algoritmo para el RFC te agradeceria que me lo envies...saludos desde merida
Por favor enviarme el archivo te lo agradecer pues la verdad me urge de antemano gracias
Me podrias facilitar tu programa en Dbase para el calculo del Homoclave
Te agradecería mucho que me enviaras el código para calcular la homoclave del RFC.
Saludos desde Tijuana
Saludos desde Tijuana
Hola, como puedo conseguir el software de Dbase?? me gustaria aprender ese lenguaje.
Gracias
Gracias
Si tienes el programa en dbase o el algoritmo, me harias un gran favor . Si me lo puedes enviar, te lo agradecere infinitamente
Gracias!!
Gracias!!
me puedes enviar el software para obtener la homoclave de personas morales, gracias
A mi si me ayudaria mucho si me proporcionas lo que tienes para el calculo de homoclave y mucho te lo agradeceria.
Me podrías mandar de favor el código del RFC con homoclave que tienes en Dbase. Gracias
si me pudieras enviar el programa o algoritmo para la obtención de la HOMOCLAVE en el RFC
MUCHO TE LO AGRADECERIA
DE ANTEMANO MUCHISISISISIMAS GRACIAS
MUCHO TE LO AGRADECERIA
DE ANTEMANO MUCHISISISISIMAS GRACIAS
saludos mi nombre es Anselmo Sarmiento y te agradeceria si me pudieras indicar como y con que programa puedo obtener el RFC de una persona fisica, gracias y espero poder corresponder con alguna informacion que necesite.
Me sería de bastante utilidad si me regalas una copia de tu algoritmo. Mil gracias
Hola amigo fijate que me enteré de que tienes la rutina del RFC echeme la mano y enviamela a mi correo ó al de mi marido [email protected] por favorsote eres muy amable gracias
Me pudieras enviar el algoritmo o el codigo para calcular la homoclave por favor
Gracias de antemano
Gracias de antemano
Estoy muy interesada en saber acerca del programita del calculo de la homoclave del R.F.C., podrias enviarme informacion por favor te lo agradezco mucho
BUEN DIA.
ESPERO QUE TENGAS LA BASE QUE SIRVE PARA CALCULAR EL RFC PARA QUE POR FA VOR SI PUEDES ENVIARMELA, POR FA.
PREGUNTILLA, TE SABES SOLO LA LOGICA DE COMO SE CALCULA EL RFC.
GRACIAS
ESPERO QUE TENGAS LA BASE QUE SIRVE PARA CALCULAR EL RFC PARA QUE POR FA VOR SI PUEDES ENVIARMELA, POR FA.
PREGUNTILLA, TE SABES SOLO LA LOGICA DE COMO SE CALCULA EL RFC.
GRACIAS
HOLA NECESITO OBTENER LA HOMOCLAVES PARA DECLARACION INFORMATIVA DE UNOS TRABAJADORES, ME PODRIAS AYUDAR? DE ANTEMANO GRACIAS
Deseo saber la homoclave, sÍ es por vía electronica está muy bien y sino favor de enviarme un dato preciso del número telefonico o dirección dónde la puedo obtener
en esta direccion encomtraran gratuitamente los programas no oficiales para calcular el rfc y curp recuerden que deben registrar a sus trabajadores por medio de un disquete y shcp expedira al patron las constancias de registro de sus trabajadores haganlo con tiempo el plazo vence el 15 feb 2005 si no deducibles los importes de sueldos y salario.
al ejecutar los programas en la mayoria de los win no traen el archivo EXECUTABLE ya que se aloja en win/sistem.. perp instalando la version ARsua se corrige este problemita
al ejecutar los programas en la mayoria de los win no traen el archivo EXECUTABLE ya que se aloja en win/sistem.. perp instalando la version ARsua se corrige este problemita
deseo saber como obtener mi homoclave y cuales son los pasos a seguir
YA habras conseguido el algoritmo para determinar la homoclave ?
porque yo necesito ese algorimo, para genear la homoclave de 35000
empleados aproximadamente,
SALUDOS
carlos lopez
porque yo necesito ese algorimo, para genear la homoclave de 35000
empleados aproximadamente,
SALUDOS
carlos lopez
REQUIERO IMPRIMIR MI DUPLICADO DE R.F.C.
VICL820827422
VICL820827422
La homoclave en México es asignada por la Secretaría de Hacienda. Lo que es calculable es el RFC en sí, y en SQL tengo esto:
SELECT nombre, ap_pat, ap_mat, fecha_nac,
Left(ap_pat,1)+ IIF(Mid(ap_pat,2,1) IN (A,E,I,O,U), Mid(ap_pat,2,1),
IIF(Mid(ap_pat,3,1) IN (A,E,I,O,U),Mid(ap_pat,3,1),
IIF(Mid(ap_pat,4,1) IN (A,E,I,O,U),Mid(ap_pat,4,1),Mid(ap_pat,5,1)))) +Left(ap_mat,1)+Rigth(Cstr(Year(fecha_nac)),2)
+IIF(Month(fecha_nac)<10,0+Cstr(Month(fecha_nac)), Cstr(Month(fecha_nac)))+
IIF(Day(fecha_nac)<10,0+Cstr(Day(fecha_nac)), Cstr(Day(fecha_nac)))
FROM empleados
Obviamente se puede crear una función en cualquier lenguaje de programación.
Saludos
SELECT nombre, ap_pat, ap_mat, fecha_nac,
Left(ap_pat,1)+ IIF(Mid(ap_pat,2,1) IN (A,E,I,O,U), Mid(ap_pat,2,1),
IIF(Mid(ap_pat,3,1) IN (A,E,I,O,U),Mid(ap_pat,3,1),
IIF(Mid(ap_pat,4,1) IN (A,E,I,O,U),Mid(ap_pat,4,1),Mid(ap_pat,5,1)))) +Left(ap_mat,1)+Rigth(Cstr(Year(fecha_nac)),2)
+IIF(Month(fecha_nac)<10,0+Cstr(Month(fecha_nac)), Cstr(Month(fecha_nac)))+
IIF(Day(fecha_nac)<10,0+Cstr(Day(fecha_nac)), Cstr(Day(fecha_nac)))
FROM empleados
Obviamente se puede crear una función en cualquier lenguaje de programación.
Saludos
al parecer mi rfc no lo tengo completo, como puedo conseguirlo y con su homonimia? SAVC630806
ME GUSTARIA ME AYUDARAN A DARME MI HOMONIMIA, AEL PARECER NO LO TENGO COMPLETO, SAVC630806 ESTO ME HA IMPEDIDO REALIZAR TRAMITES Y REGISTRO POR INTERNET. GRACIAS.
Me podrian enviar mi homoclave por mi correo a la brevedad
deseo saber homoclave del registro federal de contribuyentes
me urge la homoclave como le puedo hacer para obtenerla les agradesco por tener una pronta respuesta de parte suya
¿Alguien tiene el código en Visual Basic para calcular la CURP y que funcione bien?
Tengo un componente en VB.
Esta en versión trial por 10 rfc's, si desea la versión completa. contactame.
Esta en versión trial por 10 rfc's, si desea la versión completa. contactame.
Buena tarde .... veo que sabes como calcular la HOMOCLAVE del RFC en México.
Me podrías pasar ese programa, por favor.
Por tu atención gracias y estoy para servirte.
Me podrías pasar ese programa, por favor.
Por tu atención gracias y estoy para servirte.
POR FAVOR SI ME PUEDEN AYUDAR CON LAS
HOMOCLAVES DE LAS SGTES PERSONAS
AGUILAR EUAN JESUS ALEJANDRO AUEJ-870402
BAAS CEN JOSE JULIAN BACJ-780216
BLANCO ROSADO MANUEL AVELINO BARN-770107
CARDENA MORENO AGUSTIN ANGEL CAMA-520615
HOMOCLAVES DE LAS SGTES PERSONAS
AGUILAR EUAN JESUS ALEJANDRO AUEJ-870402
BAAS CEN JOSE JULIAN BACJ-780216
BLANCO ROSADO MANUEL AVELINO BARN-770107
CARDENA MORENO AGUSTIN ANGEL CAMA-520615