algun procedimiento para obtener el RFC

[[egostar]]

Empezado por JXJ

FGarcia Yo pense que era Registro Federal de contribuyentes

Es lo mismo, Causante y Contribuyentes.

Saludos

[Faust]

Me parece muy largo el proc. de nuestro compañero Goyo pero muy eficiente pues a la hora de generar una clave RFC se deben discriminar algunas palabras tales como eliminar los artículos del nombre, algunos nombres como María, José, creo que Juan también, separar y reconocer el nombre de los apellidos y algunas cosillas más, si tengo tiempo voy a tratar de traducirla a Delphi y ponerla en el foro o mejor aún entre los trucos, pues nos sería de utilidad a algunos de nosotros que nos encontramos en México y nunca falta que alguno tenga que programar por ejemplo algun programilla para calcular nóminas.

[Goyo]

encontre este codigo para calcular el Registro Federal de Causantes (Contribuyentes) para personas fisicas... solo que no se como aplicarlo, se que es un archivos *.pas pero no se como hacer el llamado para ver si funciona....

aqui les dejo es codigo en delphi:

Código Delphi [-]
unit U_curp;
interface
uses SysUtils;
var
VLET, VPASO, VAPL1, VAPL11, VAPL2,VAPL21, VNOM, VNOM1, VRAIZ : STRING;
VFEC_ANIO, VFEC_MES, VFEC_DIA, VSEXO, VENT : STRING;
VLEN, VI: INTEGER ;
ATAB1 : array[0..18] of string = ('DA ','DAS ','DE ','DEL ','DER ','DI ','DIE ',
                                  'DD ','EL ' ,'LA ','LOS ','LAS ','LE ','LES ',
                                  'MAC ','MC ','VAN ','VON ','Y ');
ATAB2 : array[0..74] of string = ( 'BUEI','BUEY','CACA','CACO','CAGA','CAGO','CAKA',
                                   'CAKO','COGE', 'COGI', 'COJA', 'COJE', 'COJI', 'COJO',
                                   'COLA', 'CULO', 'FALO', 'FETO', 'GETA', 'GUEI', 'GUEY',
                                   'JETA', 'JOTO', 'KACA', 'KACO', 'KAGA', 'KAGO', 'KAKA',
                                   'KAKO', 'KOGE', 'KOGI', 'KOJA', 'KOJE', 'KOJI', 'KOJO',
                                   'KOLA', 'KULO', 'LILO', 'LOCA', 'LOCO', 'LOKA', 'LOKO',
                                   'MAME', 'MAMO', 'MEAR', 'MEAS', 'MEON', 'MIAR', 'MION',
                                   'MOCO', 'MOKO', 'MULA', 'MULO', 'NACA', 'NACO', 'PEDA',
                                   'PEDO', 'PENE', 'PIPI', 'PITO', 'POPO', 'PUTA', 'PUTO',
                                   'QULO', 'RATA', 'ROBA', 'ROBE', 'ROBO', 'RUIN', 'SENO',
                                   'TETA', 'VUEI', 'VUEY', 'WUEI', 'WUEY');
Procedure curp ;
Procedure P7;
Procedure P8;
Procedure P9;
Procedure P10;
Procedure P11;
Procedure P12;
implementation
uses
  Dialogs;
Procedure curp ;
VAR VI : INTEGER;
begin
//   *** QUITA / ' .
   VPASO := TRIM(VAPL1) ;    P8()  ;  VAPL11 := VPASO ;
   VPASO := TRIM(VAPL2) ;    P8()  ;  VAPL21 := VPASO ;
   VPASO := TRIM(VNOM ) ;    P8()  ;  VNOM1  := VPASO ;
//** QUITA CARACTERES ESPECIALES
   VPASO := VAPL11      ;    P7()  ;  VAPL11 := VPASO ;
   VPASO := VAPL21      ;    P7()  ;  VAPL21 := VPASO ;
   VPASO := VNOM1       ;    P7()  ;  VNOM1  := VPASO ;
//** QUITA MARIA Y JOSE
   VPASO := VNOM1       ;    P9()  ;  VNOM1  := VPASO ;
//** QUITA PROPOSICIONES
   VPASO := VAPL11      ;   P10()  ;  VAPL11 := VPASO ;
   VPASO := VAPL21      ;   P10()  ;  VAPL21 := VPASO ;
   VPASO := VNOM1       ;   P10()  ;  VNOM1  := VPASO ;
//*** QUITO PALABRAS COMPUESTAS
   VPASO := VAPL11      ;   P11()  ;  VAPL11 := VPASO ;
   VPASO := VAPL21      ;   P11()  ;  VAPL21 := VPASO ;
   VPASO := VNOM1       ;   P11()  ;  VNOM1  := VPASO ;
//*** CREA LAS PRIMERAS 4 LETRAS DE LA RAIZ
//*** APELLIDO PATERNO
   IF LENGTH(VAPL11) = 0  THEN   VRAIZ := 'XX'
   ELSE
      BEGIN
       VRAIZ := COPY(VAPL11,1,1);
       VLET  := 'X'  ;
       FOR VI := 2 TO LENGTH(VAPL11) DO
        begin
         IF Pos(copy(VAPL11,VI,1),'AEIOU') >0 then
            begin
            VLET := copy(VAPL11,VI,1);
            Break ; //cancela el ciclo
            end;
        end; //NEXT;
       VRAIZ := VRAIZ+VLET ;
      END;

//   *** APELLIDO MATERNO
   IF LENGTh(VAPL21) = 0 THEN VRAIZ := VRAIZ+'X'
   ELSE                       VRAIZ := VRAIZ+COPY(VAPL21,1,1);
//   *** NOMBRE
   IF LENgth(VNOM1)  = 0 then VRAIZ := VRAIZ+'X'
   ELSE                       VRAIZ := VRAIZ+copy(VNOM1 ,1,1);
   FOR VI := 1 TO 75  do
   begin
      IF VRAIZ = ATAB2[VI] then
         begin
         VRAIZ := copy(VRAIZ,1,1)+'X'+copy(VRAIZ,LENGTH(VRAIZ)-1,2);//           RIGHT(VRAIZ,2)
         Break; //EXIT
         end;
   end;

//   *** FECHA NACIMIENTO, SEXO Y E.F.
         VRAIZ := VRAIZ+VFEC_ANIO+VFEC_MES+VFEC_DIA+VSEXO+VENT ;
{         VRAIZ := VRAIZ+RIGHT(STR(VFEC_ANIO,4),2)+
         REPL('0',2-LEN(LTRIM(STR(VFEC_MES,2))))+ LTRIM(STR(VFEC_MES,2))+
         REPL('0',2-LEN(LTRIM(STR(VFEC_DIA,2))))+
         LTRIM(STR(VFEC_DIA,2))+
         VSEXO+
         VENT
 }
{   IF LEVEL1 = 2 .AND. LEVEL2 = 1
         VRAIZ = VRAIZ+RIGHT(STR(VFEC_ANIO,4),2)+REPL('0',2-LEN(LTRIM(STR(VFEC_MES,2))))+LTRIM(STR(VFEC_MES,2))+REPL('0',2-LEN(LTRIM(STR(VFEC_DIA,2))))+LTRIM(STR(VFEC_DIA,2))+VSEXO+VENT
   ELSE
      IF level1 = 1 .and. level2 = 3
         VRAIZ = VRAIZ+RIGHT(STR(VFEC_ANIO,4),2)+REPL('0',2-LEN(LTRIM(STR(VFEC_MES,2))))+LTRIM(STR(VFEC_MES,2))+REPL('0',2-LEN(LTRIM(STR(VFEC_DIA,2))))+LTRIM(STR(VFEC_DIA,2))+VSEXO+VENT
      ELSE
         VRAIZ = VRAIZ+RIGHT(STR(VFEC_ANIO,4),2)+REPL('0',2-LEN(LTRIM(STR(VFEC_MES,2))))+LTRIM(STR(VFEC_MES,2))+REPL('0',2-LEN(LTRIM(STR(VFEC_DIA,2))))+LTRIM(STR(VFEC_DIA,2))+VSEXO+VENT
      ENDIF
   ENDIF}
//   *** CONSONANTES INTERNAS
   VPASO := VAPL11   ; P12();
   VPASO := VAPL21   ; P12();
   VPASO := VNOM1    ; P12();
//   *** FIN DE RUTINAS
end;
Procedure P7;
VAR VI : INTEGER;
VLETRA : CHAR;
begin
//** SUSTITUYE CARACTERES ESPECIALES POR X
  FOR VI := 1 TO LENGTH(VPASO)  DO
                BEGIN  //ord devuelve el codigo ASCII
                   VLETRA := VPASO[VI];
     IF ((ord(VLETRA) < 65) OR (ord(VLETRA) > 90)) AND (copy(VPASO,VI,1) <> ' ') THEN
        VPASO  := COPY(VPASO,1,VI-1)+'X'+COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-VI)+1,LENGTH(VPASO)-VI) ;
  END;
end;
Procedure P8;
VAR VI : INTEGER ;
begin
//** QUITA LAS / Y '
//  VLEN = LEN(VPASO)
  FOR VI := 1 TO LENGTH(VPASO) DO
                BEGIN
     IF (COPY(VPASO,VI,1) = '/') OR (COPY(VPASO,VI,1) = #39) OR  (COPY(VPASO,VI,1) = '.') THEN
                    BEGIN
//        VLEFT  = LEFT(VPASO,VI-1)
//        VRIGHT = RIGHT(VPASO,VLEN-VI)
        VPASO  := COPY(VPASO,1,VI-1)+' '+ COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-VI)+1,LENGTH(VPASO)-VI) ;
      END;
  END;
  VPASO := TRIM(VPASO);
end;
Procedure P9;
begin
//** QUITA JOSE Y MARIA
IF (COPY(VPASO,1,4) = 'JOSE' )  AND (LENGTH(VPASO) = 4) THEN EXIT ;
IF (COPY(VPASO,1,1) = 'J'    )  AND (LENGTH(VPASO) = 1) THEN EXIT ;
IF (COPY(VPASO,1,2) = 'J '   )  AND (LENGTH(VPASO) = 2) THEN EXIT ;
IF (COPY(VPASO,1,5) = 'MARIA')  AND (LENGTH(VPASO) = 5) THEN EXIT ;
IF (COPY(VPASO,1,1) = 'M'    )  AND (LENGTH(VPASO) = 1) THEN EXIT ;
IF (COPY(VPASO,1,2) = 'M '   )  AND (LENGTH(VPASO) = 2) THEN EXIT ;
IF (COPY(VPASO,1,2) = 'MA'   )  AND (LENGTH(VPASO) = 2) THEN EXIT ;
IF (COPY(VPASO,1,3) = 'MA '  )  AND (LENGTH(VPASO) = 3) THEN EXIT ;
IF COPY(VPASO,1,5) = 'JOSE '  THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-5)+1, LENGTH(VPASO)-5);    EXIT ; END;
IF COPY(VPASO,1,3) = 'J  '    THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-3)+1, LENGTH(VPASO)-3);    EXIT ; END;
IF COPY(VPASO,1,2) = 'J '     THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-2)+1, LENGTH(VPASO)-2);    EXIT ; END;
IF COPY(VPASO,1,6) = 'MARIA ' THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-6)+1, LENGTH(VPASO)-6);    EXIT ; END;
IF COPY(VPASO,1,3) = 'M  '    THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-3)+1, LENGTH(VPASO)-3);    EXIT ; END;
IF COPY(VPASO,1,2) = 'M '     THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-2)+1, LENGTH(VPASO)-2);    EXIT ; END;
IF COPY(VPASO,1,4) = 'MA  '   THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-4)+1, LENGTH(VPASO)-4);    EXIT ; END;
IF COPY(VPASO,1,3) = 'MA '    THEN BEGIN  VPASO := COPY(VPASO,LENGTH(VPASO)-(LENGTH(VPASO)-3)+1, LENGTH(VPASO)-3);    EXIT ; END;
end;
Procedure P10;
VAR VI : INTEGER ;
begin
//** QUITA PREPOSICIONES
        VI := 0;
        WHILE VI < 20 DO
 //FOR VI := 1 TO 19 DO
        BEGIN
           VI := VI+1 ;
    IF COPY(VPASO,1,LENGTH(ATAB1[VI])) = ATAB1[VI] THEN
              BEGIN
       VPASO := TRIM(COPY(VPASO, LENGTH(VPASO)-(LENGTH(VPASO)-LENGTH(ATAB1[VI]))+1,LENGTH(VPASO)-LENGTH(ATAB1[VI])));
          VI := 1 ;
       END;
 END;
end;

Procedure P11;
VAR VI : INTEGER;
begin
//** QUITA PALABRAS COMPUESTAS
 FOR VI := 1 TO LENGTH(VPASO) DO
        BEGIN
    IF COPY(VPASO,VI,1) = ' ' THEN
              BEGIN
       VPASO := COPY(VPASO,1,VI-1);
       EXIT;
              END;
        END;
end;
Procedure P12;
VAR VLET : STRING;
VI : INTEGER;
begin
//** CONSONANTES INTERNAS
      //  MessageDlg('VPASO= '+VPASO , mtWarning, [mbOK], 0);
 IF LENGTH(VPASO) = 0 THEN  VRAIZ := VRAIZ+'X'
 ELSE
         BEGIN
    VLET := 'X' ;
    FOR VI := 2 TO LENGTH(VPASO) DO
           BEGIN
       IF POS(COPY(VPASO,VI,1),'BCDFGHJKLMNPQRSTVWXYZ')>0 THEN
                BEGIN
          VLET := COPY(VPASO,VI,1) ;
                 VRAIZ := VRAIZ+VLET ;
          EXIT ;
         END;
    END;
   END;
end;
 
end.

... si alguien lo puede implementar, favor de notificarlo... gracias

[erikmx]

Saludos Goyo, buscando en internet y en el foro me encontre el codigo que encontraste en el 2007 para calcular el RFC y la CURP actualmente estoy buscando la forma de hacerlo desde mi programa en delphi pero no he logrado conseguir algo que sea efectivo por no decir que casi nada, este codigo es de los pocos que he visto en delphi aunque para calcular la curp se requiere el estado de la republica y ahi no vi donde se puede incluir o no se incluyo la lista de estados.

Queria saber si lograste hacerlo funcionar

[[AzidRain]]

El témino correcto y vigente es "contribuyente". "Causante" dejó de existir en los 80so 90s cuando nació el SAT (sistema de Administración Tributaria). Aunque el algoritmo es público (se puede conseguir directamente del SAT) cualquier RFC que no sea emitido por esta dependecia no tiene ningún valor pues a pesar de los candados se dan casos de homóminos que corresponden inclusive con las fechas de nacimiento por lo que el SAT genera un RFC diferente al que saldría con este algoritmo. Esta práctica de "crear" los rfcs directamente en las aplicaciones ya ha caído en desuso precisamente por ese problema.