www.FiveTechSoft.com
http://forums.fivetechsoft.com/
Code: Select all
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* FUNCION : CURP([cCURP] [, cPaterno] [, cMaterno] [, cNombre];
* [, fNacimiento] [, nSexo] [, cLugarNacim]) -> cCURP
* DESCRIPCION: La Clave Unica de Registro de Población (CURP) es un instrumento de registro e identificación
* que se asigna a todas las personas que viven en el territorio nacional, así como a los
* mexicanos que residen en el extranjero.
* El Registro Nacional de Población (RENAPO) es la instancia responsable de asignar la
* CURP y de expedir la constancia respectiva.
* La CURP se integra de dieciocho elementos, representados por letras y números, que se
* generan a partir de los datos contenidos en el docuemento probatorio de entidad (acta de
* nacimiento, carta de naturalización o docuemento migratorio), y que se refieren a:
* PARAMETROS : <cCURP> = Si ya tiene formado parte de la CURP, se deberá pasar en este parámetro y
* así sólo anexar la parte faltante.
* <cPaterno> = Apellido Paterno <cMaterno> = Apellido Materno
* <cNombre> = Nombre de Pila <fNacimiento>= Fecha de Nacimiento
* <nSexo> = _: 1 para Femenino, 2 para Masculino
* <cLugarNacim> = Clave de la Entidad Federativa de nacimiento.
* REGRESA : Una cadena de 18 caracteres que contiene parte ó toda la CURP, según los parámetros enviados.
* EJEMPLO : ? CURP(, "Alamán", "Pérez", "Ricardo", CTOD("21/03/63"), 2, "DF")
* -> "AAPR630321HDFLRC09" // Se forma la CURP Completa.
* ? CURP(, "Alamán", "Pérez", "Ricardo")
* -> "AAPR LRC " // Se forma sólo la parte de la CURP donde intervienen los apellidos y el nombre.
* EJEMPLO : ? CURP(, , , , CTOD("21/03/63"), 2, "DF")
* -> " 630321HDF " // Se forma sólo la parte de la CURP donde intervienen la fecha de Nacimiento, el _ y Lugar de Nacimiento.
* REQUIERE : EsVocal(), EsConsonante(), SinAcento() y FormFec() -> Sanroms.Prg
*
FUNCTION CURP(cCURP, cPaterno, cMaterno, cNombre, fNacimiento, nSexo, cLugarNacim, lVerif)
LOCAL cConsonante, cElement, cLetra, cPalabra, cVerif, cVocal
LOCAL nLetra
LOCAL aAntiSonantes := {"BUEI",;
"BUEY",;
"CACA",;
"CACO",;
"CAGA",;
"CAGO",;
"CAKA",;
"CAKO",;
"COGE",;
"COJA",;
"COJE",;
"COJI",;
"COJO",;
"CULO",;
"FETO",;
"GUEY",;
"JOTO",;
"KACA",;
"KACO",;
"KAGA",;
"KAGO",;
"KAKA",;
"KOGE",;
"KOJO",;
"KULO",;
"LOCA",;
"LOCO",;
"LOKA",;
"LOKO",;
"MAME",;
"MAMO",;
"MEAR",;
"MEAS",;
"MEON",;
"MION",;
"MOCO",;
"MULA",;
"PEDA",;
"PEDO",;
"PENE",;
"PUTA",;
"PUTO",;
"QULO",;
"RATA",;
"ROBE",;
"RUIN",;
"VAGA",;
"VAGO"}
DEFAULT cCURP := SPACE(18)
DEFAULT lVerif:= .F.
IF !EMPTY(cPaterno)
cPaterno := AnsiUpper( ALLTRIM(cPaterno) )
// 1.- Inicial del primer apellido...
cLetra:= SinAcento( SUBSTR(cPaterno, 1, 1) )
cCURP := STUFF(cCURP, 1, 1, IIF(cLetra = "Ñ", "X", cLetra)) // Las "Ñ" no son permitidas, en lugar de ésta una "X".
// 2.- Primera vocal interna del primer apellido...
// ** Si el primer apellido NO tiene Vocal Interna: Se deberá anotar una "X" **
cVocal := "X"
FOR nLetra := 2 TO LEN(cPaterno)
cLetra := SUBSTR(cPaterno, nLetra, 1)
IF EsVocal(cLetra)
cVocal := SinAcento(cLetra)
EXIT
ENDIF
NEXT
cCURP := STUFF(cCURP, 2, 1, cVocal)
ENDIF
IF cMaterno <> NIL
cMaterno := AnsiUpper( ALLTRIM(cMaterno) )
// 3.- Inicial del segundo apellido...
IF !EMPTY(cMaterno)
cLetra:= SinAcento( SUBSTR(cMaterno, 1, 1) )
ELSE
cLetra := "X" // ** Si NO Existe segundo apellido: Se deberá anotar una "X".
ENDIF
cCURP := STUFF(cCURP, 3, 1, IIF(cLetra = "Ñ", "X", cLetra))
ENDIF
IF !EMPTY(cNombre)
cNombre := SinAcento(AnsiUpper( ALLTRIM(cNombre) ))
IF StrWord(cNombre) > 1 // Se verifica si el nombre está formado por más de una palabra...
DO CASE
CASE "JOSE" IN cNombre
cNombre := StrTran(cNombre, "JOSE")
CASE "MARIA" IN cNombre
cNombre := StrTran(cNombre, "MARIA")
ENDCASE
ENDIF
cNombre := ALLTRIM(cNombre)
// 4.- Inicial del nombre de pila.
cLetra:= LEFT(cNombre, 1)
cCURP := STUFF(cCURP, 4, 1, IIF(cLetra = "Ñ", "X", cLetra)) // Las "Ñ" no son permitidas, en lugar de ésta una "X".
ENDIF
// Se verifica que no se haya formado una palabra Anti-sonante...
cPalabra := SUBSTR(cCURP, 1, 4)
FOR EACH cElement IN aAntiSonantes
IF cPalabra == cElement
cCURP := STUFF(cCURP, 2, 1, "X") // Se pone una "X" en la posición 2 de la palabra Anti-sonante.
EXIT
ENDIF
NEXT
IF !EMPTY(fNacimiento)
// 5.- Fecha de nacimiento: año, mes y día.
cCURP := STUFF(cCURP, 5, 6, FormFec("[A][M][DDD]", fNacimiento))
ENDIF
IF !EMPTY(nSexo)
// 6.- _: (H) para hombre y (M) para mujer.
cCURP := STUFF(cCURP, 11, 1, IIF(nSexo = 1, "M", "H"))
ENDIF
IF !EMPTY(cLugarNacim)
cLugarNacim := UPPER(cLugarNacim)
// 7.- Entidad federativa de nacimiento.
cCURP := STUFF(cCURP, 12, 2, cLugarNacim)
ENDIF
IF !EMPTY(cPaterno)
// 8.- Primera consonante interna del primer apellido.
// ** En caso de NO existir Consonantes Internas en el primer apellido: Se colocará una "X" **
cConsonante := "X"
FOR nLetra := 2 TO LEN(cPaterno)
cLetra := SUBSTR(cPaterno, nLetra, 1)
IF EsConsonante(cLetra)
cConsonante := cLetra
EXIT
ENDIF
NEXT
cCURP := STUFF(cCURP, 14, 1, IIF(cConsonante = "Ñ", "X", cConsonante))
ENDIF
IF cMaterno <> NIL
// 9.- Primera consonante interna del segundo apellido.
cConsonante := "X"
IF !EMPTY(cMaterno)
FOR nLetra := 2 TO LEN(cMaterno)
cLetra := SUBSTR(cMaterno, nLetra, 1)
IF EsConsonante(cLetra)
cConsonante := cLetra
EXIT
ENDIF
NEXT
ENDIF
cCURP := STUFF(cCURP, 15, 1, IIF(cConsonante = "Ñ", "X", cConsonante))
ENDIF
IF !EMPTY(cNombre)
// 10.- Primera consonante interna del nombre de pila.
cConsonante := "X"
FOR nLetra := 2 TO LEN(cNombre)
cLetra := SUBSTR(cNombre, nLetra, 1)
IF EsConsonante(cLetra) .AND. cLetra <> "Ñ"
cConsonante := cLetra
EXIT
ENDIF
NEXT
cCURP := STUFF(cCURP, 16, 1, cConsonante)
ENDIF
IF lVerif // Cálculo de dígitos verificadores...
cCURP := SUBSTR(cCURP, 1, 16)
cVerif:= CURPVerif(cCURP + "0")
cCURP := STUFF(cCURP, 17, 2, cVerif)
ENDIF
RETURN (cCURP)
*
* FIN CURP()
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
isolis wrote:Espero te sirva...
Saludos!!
Francisco Horta wrote:por aqui dejo un link que habia encontrado
http://mx.geocities.com/fjgm07/rfc.txt
salu2
paco
Code: Select all
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* FUNCION : EsVocal(cLetra) -> lVocal
* DESCRIPCION: Investiga si un caracter es Vocal, aún cuando se encuentre acentuada.
* REGRESA : .T. si el caracter es Vocal, en caso contrario devuelve .F.
* PARAMETROS : <cLetra> = Caracter a investigar si se trata de una vocal.
* EJEMPLO : ? EsVocal("a") -> .T. ? EsVocal("8") -> .F.
* ? EsVocal("ú") -> .T. ? EsVocal("P") -> .F.
* ? EsVocal("E") -> .T. ? EsVocal("=") -> .F.
* REQUIERE : SinAcento() -> Sanroms.Prg
*
FUNCTION EsVocal(cLetra)
DEFAULT cLetra := SPACE(1)
IF VALTYPE(cLetra) <> "C" // Valida que el parámetro pasado se trate de un caracter.
cLetra := SPACE(1)
ENDIF
cLetra := UPPER(SinAcento( ALLTRIM(cLetra) )) // Anula espacios, quita el acento y convierte a mayúscula para la comparación.
IF cLetra = "A" .OR. cLetra = "E" .OR. cLetra = "I" .OR.;
cLetra = "O" .OR. cLetra = "U"
RETURN(.T.)
ENDIF
RETURN (.F.)
*
* FIN EsVocal()
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* FUNCION : EsConsonante(cLetra) -> lConsonante
* DESCRIPCION: Investiga si un caracter es Consonante.
* REGRESA : .T. si el caracter es Consonante, en caso contrario devuelve .F.
* PARAMETROS : <cLetra> = Caracter a investigar si se trata de una consonante.
* EJEMPLO : ? EsVocal("P") -> .T. ? EsVocal("8") -> .F.
* ? EsVocal("m") -> .T. ? EsVocal("A") -> .F.
* ? EsVocal("x") -> .T. ? EsVocal("=") -> .F.
* REQUIERE : EsVocal() -> Sanroms.Prg
*
FUNCTION EsConsonante(cLetra)
DEFAULT cLetra := SPACE(1)
cLetra := UPPER( ALLTRIM(cLetra) )
IF cLetra = "B" .OR. cLetra = "C" .OR. cLetra = "D" .OR. cLetra = "F" .OR.;
cLetra = "G" .OR. cLetra = "H" .OR. cLetra = "J" .OR. cLetra = "K" .OR.;
cLetra = "L" .OR. cLetra = "M" .OR. cLetra = "N" .OR. cLetra = "Ñ" .OR.;
cLetra = "P" .OR. cLetra = "Q" .OR. cLetra = "R" .OR. cLetra = "S" .OR.;
cLetra = "T" .OR. cLetra = "V" .OR. cLetra = "W" .OR. cLetra = "X" .OR.;
cLetra = "Y" .OR. cLetra = "Z"
RETURN(.T.)
ENDIF
RETURN(.F.)
*
* FIN EsConsonante()
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* FUNCION : SinAcento(<cCadena>) -> cCadena
* DESCRIPCION: Quita los acentos a la cadena pasada.
* REGRESA : <cCadena> pero SIN Acento
* PARAMETROS : <cCadena> = Cadena a eliminarle los acentos.
* EJEMPLO : ? SinAcento("Sánchez") -> "Sanchez" ? SinAcento("8") -> "8"
* ? SinAcento("É") -> "E" ? SinAcento("A") -> "A"
* ? SinAcento("LÓPEZ") -> "LOPEZ" ? SinAcento("=") -> "="
*
FUNCTION SinAcento(cCadena)
DEFAULT cCadena := SPACE(1)
IF VALTYPE(cCadena) <> "C"
cCadena := SPACE(1)
ENDIF
cCadena := StrTran(cCadena, "Á", "A")
cCadena := StrTran(cCadena, "É", "E")
cCadena := StrTran(cCadena, "Í", "I")
cCadena := StrTran(cCadena, "Ó", "O")
cCadena := StrTran(cCadena, "Ú", "U")
cCadena := StrTran(cCadena, "á", "a")
cCadena := StrTran(cCadena, "é", "e")
cCadena := StrTran(cCadena, "í", "i")
cCadena := StrTran(cCadena, "ó", "o")
cCadena := StrTran(cCadena, "ú", "u")
RETURN(cCadena)
*
* FIN SinAcento()
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
isolis wrote:Luis:
EsVocal(), EsConsonante() y SinAcento()
SALUDOS!!
Hola Israel que tal como esta, yo soy un desarrollador de FiveWin que aun me falta mucho por aprender, soy de Cancun, ya tengo desarrollado un sistema de control de proveedores algo parecido a contabiliad de 3 niveles de cuentas y me gustaria intercambiar conocimientos y experiencias se podra ? le dejo mi correo y gusto saludarte y encontrarme alguien de mi misma localidad Cancunisolis wrote:Luis:
Mil disculpas pero te voy a deber la función CURPVerif() ya que el autor no me permite la distibución, esta función solo se encarga de calcular los dígitos verificadores pero obviamente son los que proporciona gobernación los realmente válidos (asignados oficialmente a la persona).
Sobre la función FormFec() es original de Grupo Eidos (Librerias en Clipper 5, Ra-ma, Addison-Wesley Iberoamericana, 1992) y a su vez requiere de varias funciones mas, por lo que sería largo el ponertelas todas aqui, envíame un privado.
SALUDOS!!
isolis wrote:Luis:
Mil disculpas pero te voy a deber la función CURPVerif() ya que el autor no me permite la distibución, esta función solo se encarga de calcular los dígitos verificadores pero obviamente son los que proporciona gobernación los realmente válidos (asignados oficialmente a la persona).
Sobre la función FormFec() es original de Grupo Eidos (Librerias en Clipper 5, Ra-ma, Addison-Wesley Iberoamericana, 1992) y a su vez requiere de varias funciones mas, por lo que sería largo el ponertelas todas aqui, envíame un privado.
SALUDOS!!