Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Firebird e Interbase (https://www.clubdelphi.com/foros/forumdisplay.php?f=19)
-   -   Procedimiento Calculo RFC (https://www.clubdelphi.com/foros/showthread.php?t=75250)

roman 11-08-2011 23:41:01

Todavía no tengo mucho tiempo para lo del dígito verificador pero aprovecho para comentar que en esta página http://www.aplicarh.com/ pueden descargar una aplicación que calcula el RFC. Con esto pueden probar qué tal funciona su algoritmo.

// Saludos

roman 12-08-2011 06:22:35

¡Listo! Ya completé la parte del dígito verificador y puse algunas observaciones finales.

// Saludos

Gallosuarez 12-08-2011 13:48:16

Pendientes ...
 
Román:

Gracias ... bueno pues lo que sigue solo es cuestión mía ... espero que hoy por la tarde tener un versión lista ... saludos al foro ...

Atte:
Gerardo Suárez Trejo

Gallosuarez 13-08-2011 15:17:40

Primer intento ...
 
America111:

Bueno pues aquí tenemos el primer esbozo . Se debe de considerar como eso, es decir, una versión de prueba que no está lista para entrar a producción. Falta muchas protecciones, además de agregarle el código para la homoclave y el dígito verificador.

Lo programé en la versión 2.5, sin embargo creo que funcionaría desde la 2.1 (falta confirmar). Utilicé dominios en la declaración de variables (enorme ventaja de conservar consistencia en el tipo de datos entre tablas y procedimientos almacenados). No utilicé ningún UDF (ventaja que se traduce al utilizar diferentes plataformas: Linux, Mac, UNIX, Windows, etc). Planeo, para después, agregar una tabla de Personal donde utilizaré los dominios antes mencionados, además de un campo calculado para el nombre completo que estaría indexado para hacer búsquedas rapidísimas que no sean sensibles a mayúscula o a los acentos (tal y como sucede en el cálculo del RFC).
Se usa de la siguiente manera:
Código SQL [-]
SELECT RFC
FROM CALC_RFC('Del Real', 'Anzures', 'José Antonio', '04/14/1972')

ó

SELECT RFC
FROM CALC_RFC('DEL REAL', 'ANZURES', 'JOSÉ ANTONIO', '04/14/1972')

etc, etc

Código:
Código SQL [-]
/******************** DOMINIOS *********************/
CREATE DOMAIN DOM_AMATERNO
 AS Varchar(27)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_APATERNO
 AS Varchar(27)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_NOMBRECMPLTO
 AS Varchar(93)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_NOMBRES
 AS Varchar(37)
 COLLATE ES_ES_CI_AI;
CREATE DOMAIN DOM_RFC
 AS Varchar(13)
 COLLATE ES_ES_CI_AI;

/********** PROCEDIMIENTO VOCAL_MAYUSCULA ***********/
SET TERM ^ ;
CREATE PROCEDURE VOCAL_MAYUSCULA (
    C Char(1) COLLATE ES_ES_CI_AI)
RETURNS (
    VOCAL Char(1) )
AS
BEGIN
  VOCAL = C;
  IF (C IN ('Á')) THEN VOCAL = 'A';
  IF (C IN ('É')) THEN VOCAL = 'E';
  IF (C IN ('Í')) THEN VOCAL = 'I';
  IF (C IN ('Ó')) THEN VOCAL = 'O';
  IF (C IN ('Ú')) THEN VOCAL = 'U';
END^
SET TERM ; ^

/********** PROCEDIMIENTO CALC_RFC ***********/
SET TERM ^ ;
CREATE PROCEDURE CALC_RFC (
    APATERNO_PARAM DOM_APATERNO,
    AMATERNO_PARAM DOM_AMATERNO,
    NOMBRES_PARAM DOM_NOMBRES,
    F_NACIMIENTO Date )
RETURNS (
    RFC DOM_RFC )
AS
DECLARE dd CHAR(2); /* día de nacimiento */
DECLARE mm CHAR(2); /* mes de nacimiento */
DECLARE aa CHAR(2); /* año de nacimiento */
DECLARE APaterno DOM_APATERNO = '';
DECLARE AMaterno DOM_APATERNO = '';
DECLARE Nombres DOM_NOMBRES = '';
DECLARE Nombre1 DOM_NOMBRES = '';
DECLARE APaterno1 DOM_APATERNO = '';
DECLARE NombreCmplto DOM_NOMBRECMPLTO = '';
DECLARE PosEspacio INTEGER = 0; 
DECLARE PrimeraVocal CHAR(1) = ''; /* primera vocal interna */
DECLARE Cadena VARCHAR(24) = '';
DECLARE i INTEGER = 1;
DECLARE LongCadena INTEGER = 0; /* longitud de cadena */
BEGIN
  dd = LPAD(CAST(EXTRACT(DAY FROM F_NACIMIENTO) AS VARCHAR(2)), 2, '0');
  mm = LPAD(CAST(EXTRACT(MONTH FROM F_NACIMIENTO) AS VARCHAR(2)), 2, '0');
  aa = RIGHT(CAST(EXTRACT(YEAR FROM F_NACIMIENTO) AS VARCHAR(4)), 2);
  
  APaterno = TRIM(APATERNO_PARAM);
  AMaterno = TRIM(AMATERNO_PARAM);
  Nombres = TRIM(NOMBRES_PARAM);
  
  /* Bucle para procesar nombre(s) */
  WHILE (1 = 1) DO
  BEGIN
    PosEspacio = IIF(POSITION(' ', Nombres) = 0, 1, POSITION(' ', Nombres));
    Nombre1 = SUBSTRING(Nombres FROM 1 FOR PosEspacio - 1);
    IF (Nombre1 NOT IN ('JOSE','MARIA','MA.','MA','DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN')
      OR (PosEspacio - 1) = 0) THEN LEAVE;
    Nombres = SUBSTRING(Nombres FROM PosEspacio + 1);
  END
  
  /* Bucle para procesar apellido(s) paterno */
  WHILE (1 = 1) DO
  BEGIN
    PosEspacio = IIF(POSITION(' ', APaterno) = 0, 1, POSITION(' ', APaterno));
    APaterno1 = SUBSTRING(APaterno FROM 1 FOR PosEspacio - 1);
    IF (APaterno1 NOT IN ('DE','LA','LAS','MC','VON','DEL','LOS','Y','MAC','VAN')
      OR (PosEspacio - 1) = 0) THEN LEAVE;
    APaterno = SUBSTRING(APaterno FROM PosEspacio + 1);
  END
    
  /* Bucle para buscar primera vocal interna en el apellido paterno */
  Cadena = SUBSTRING(APaterno FROM 2);
  LongCadena = CHAR_LENGTH(Cadena);
  i = 1;
  WHILE (i < LongCadena) DO
  BEGIN
    EXECUTE PROCEDURE VOCAL_MAYUSCULA(SUBSTRING(Cadena FROM 1 FOR 1))
    RETURNING_VALUES PrimeraVocal;
    IF (PrimeraVocal IN ('A', 'E', 'I', 'O', 'U')) THEN LEAVE;
    Cadena = SUBSTRING(Cadena FROM 2);
    i = i + 1;
  END
  
  /* Concatena todo los resultados */
  RFC = UPPER(LEFT(APaterno, 1) || PrimeraVocal || COALESCE(LEFT(AMaterno, 1), 'X') ||
    LEFT(Nombres, 1));
  
  /* Elimina palabras "feas" */
  IF (RFC IN ('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','MAME','MAMO','MEAR','MEAS','MEON',
    'MION','MOCO','MULA','PEDA','PEDO','PENE','PUTA','PUTO','QULO','RUIN','RATA')) THEN
    RFC = SUBSTRING(RFC FROM 1 FOR 3) || 'X';
      
  /* Concatena fecha de nacimiento */  
  RFC = RFC || aa || mm || dd;
  SUSPEND;
END^
SET TERM ; ^

Saludos,
Gerardo Suárez Trejo

amerika111 15-08-2011 20:41:15

ok lo probare para el nombre y fecha de nacimiento... gracias..

amerika111 17-08-2011 17:26:01

Lo he probado pero sigo sin poder sacar la homoclave final... he checado el de sql pero no he logrado pasarlo :( a firebird

roman 17-08-2011 20:07:03

Hola,

Hay una pequeña errata en el cálculo de la homonimia que puse anteriormente, quizá por ello no te sale...

El paso 3 dice:

Cita:

3. Esta cadena se recorre de izquierda a derecha desde el primero hasta el penúltimo caracter. En la iteración i-ésima se multiplican los dígitos i e i+1.

Se suman todos los productos. En el ejemplo queda: 4756
En realidad, en cada iteración, lo que debe multiplicarse es el número formado por los dígitos i e i+1 por el dígito i. En pseudo-código:

Código:

FOR I := 1 TO LONGITUD(CADENA) - 1
  SUMA := SUMA + CADENA[i]CADENA[I+1] * CADENA[I+1];

// Saludos


La franja horaria es GMT +2. Ahora son las 07:34:50.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi