Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Proyecto AjpdSoft: Foros

AjpdSoft :: Ver tema - Calcular RFC (Registro Federal del Contribuyente) México
Foros de discusión Buscar Perfil FAQ Iniciar sesión
Information Calcular RFC (Registro Federal del Contribuyente) México

Publicar nuevo tema Responder al tema
Foros de discusión » Borland Delphi, Codegear Delphi .Net   
Ver tema anterior :: Ver tema siguiente
AutorMensaje
fvillanueva
Usuario


Registrado: Jul 22, 2014
Mensajes: 2

Asunto: Calcular RFC (Registro Federal del Contribuyente) México Responder citando

Estimados,

Derivado a la necesidad de implementar el calculo de RFC en mis sistemas y no encontrar el código en la red para Delphi, me tuve que poner a trabajar y al fin quedo. No es un código muy estético pero funciona, y lo subo aquí para compartirlo con ustedes y a este sitio que tanto me ha ayudado. Agradeceré mucho a los expertos que puedan ir mejorando este código.

Código:

function rfc(Paterno,Materno,Nombre:string;fecha:TDateTime):string;
var apaterno,amaterno,anombre,afecha,completo,cliente,vale,vale2,numeros:string;
    coef,resi,resultado,total,i,formulados:Integer;
begin
  //OBTENER LA PRIMERA LETRA DEL APELLIDO PATERNO Y LA PRIMERA VOCAL
  for i:=1 to Length(Paterno) do
  begin
    vale2 := Copy(Paterno,i,1);
    case vale2[1] of
      'A','a': begin
                 apaterno := Copy(Paterno,1,1) + 'A';
                 Break;
               end;
      'E','e': begin
                 apaterno :=Copy(Paterno,1,1) + 'E';
                 Break;
               end;
      'I','i': begin
                 apaterno :=Copy(Paterno,1,1) + 'I';
                 Break;
               end;
      'O','o': begin
                 apaterno :=Copy(Paterno,1,1) + 'O';
                 Break;
               end;
      'U','u': begin
                 apaterno :=Copy(Paterno,1,1) + 'U';
                 Break;
               end;
    end;
  end;

  if Materno = '' THEN
  begin
    amaterno := UpperCase(Nombre);
    SetLength (amaterno,1);
    Result := amaterno;
    aNombre := StringReplace(UpperCase(Nombre), 'JOSE ','',[rfReplaceAll]);
    aNombre := StringReplace(UpperCase(anombre), 'MARIA ','',[rfReplaceAll]);
    for i:=1 to Length(aNombre) do
    begin
      vale2 := Copy(Nombre,i,1);
      case vale2[1] of
        'A','a': begin
                   anombre := 'A';
                   Break;
                 end;
        'E','e': begin
                   anombre :='E';
                   Break;
                 end;
        'I','i': begin
                   apaterno := 'I';
                   Break;
                 end;
        'O','o': begin
                   apaterno := 'O';
                   Break;
                 end;
        'U','u': begin
                   apaterno := 'U';
                   Break;
                 end;
      end;
    end;
    completo := apaterno + anombre + amaterno;
    Result := UpperCase(completo);
  end
  else
  begin
    amaterno := Materno;
    SetLength(aMaterno,1);
    Result := aMaterno;
    anombre := StringReplace(UpperCase(Nombre), 'JOSE ','',[rfReplaceAll]);
    anombre := StringReplace(UpperCase(anombre), 'MARIA ','',[rfReplaceAll]);
    Result := anombre;
    SetLength(aNombre,1);
    Result := anombre;
    completo := UpperCase(apaterno + amaterno + anombre);
  END;

    completo := StringReplace(completo, 'JOSE ','',[rfReplaceAll]);
    completo := StringReplace(completo, 'MARIA ','',[rfReplaceAll]);

  if AnsiIndexText( completo, ['BUEI','BUEY','CACA','CACO','CAGA','CAGO',
      'CAKA','COGE','COJA','COJE','COJI','COJO','CULO','FETO','GUEY','JOTO','KACA','KACO','KAGA',
      'KAGO','KOGE','KOGO','KAKA','KULO','MAME','MAMO','MEAR','MEON','MION','MOCO','MULA','PEDA',
      'PEDO','PENE','PUTO','PUTA','QULO','RATA','RUIN']) >=0 then
  begin
    afecha := FormatDateTime('YYMMDD',fecha);
    SetLength ( afecha, 6);
    Result := afecha;

    anombre := 'X';
    completo:= apaterno + amaterno + aNombre + afecha;
    Result := UpperCase(completo);
  end
  else
  begin
    afecha := FormatDateTime('YYMMDD',fecha);
    SetLength ( afecha, 6);
    Result := afecha;

    completo:= apaterno + amaterno + aNombre + afecha;
    Result := UpperCase(completo);
  end;

  numeros := '0';
  resultado := 0;
  coef := 0;
  resi := 0;
  cliente := paterno + ' ' + materno + ' ' + nombre;
  total := 0;

  //OBTENEMOS LA SERIE DE DIGITOS DE ACUERDO A LAS LETRAS DE NUESTRO NOMBRE
  //EMPEZANDO POR AP. PATERNO, MATERNO Y NOMBRE
  for i:=1 to Length(cliente) do
  begin
    vale := Copy(cliente,i,1);
    case vale[1] of
      '0',' ': numeros := numeros + '00';
      '1': numeros := numeros + '01';
      '2': numeros := numeros + '02';
      '3': numeros := numeros + '03';
      '4': numeros := numeros + '04';
      '5': numeros := numeros + '05';
      '6': numeros := numeros + '06';
      '7': numeros := numeros + '07';
      '8': numeros := numeros + '08';
      '9': numeros := numeros + '09';
      '&': numeros := numeros + '10';
      'A','a': numeros := numeros + '11';
      'B','b': numeros := numeros + '12';
      'C','c': numeros := numeros + '13';
      'D','d': numeros := numeros + '14';
      'E','e': numeros := numeros + '15';
      'F','f': numeros := numeros + '16';
      'G','g': numeros := numeros + '17';
      'H','h': numeros := numeros + '18';
      'I','i': numeros := numeros + '19';
      'J','j': numeros := numeros + '21';
      'K','k': numeros := numeros + '22';
      'L','l': numeros := numeros + '23';
      'M','m': numeros := numeros + '24';
      'N','n': numeros := numeros + '25';
      'O','o': numeros := numeros + '26';
      'P','p': numeros := numeros + '27';
      'Q','q': numeros := numeros + '28';
      'R','r': numeros := numeros + '29';
      'S','s': numeros := numeros + '32';
      'T','t': numeros := numeros + '33';
      'U','u': numeros := numeros + '34';
      'V','v': numeros := numeros + '35';
      'W','w': numeros := numeros + '36';
      'X','x': numeros := numeros + '37';
      'Y','y': numeros := numeros + '38';
      'Z','z': numeros := numeros + '39';
      'Ñ','ñ': numeros := numeros + '40';
    end;
  end;

  //sE TOMAN GRUPOS DE DOS CARACTERES NUMERICOS Y SE MULTIPLICA
  //POR EL SEGUNDO CARACTER, SE REPETIRA ESTE PROCESO HASTA TERMINAR CON LA SERIE
  for i:=1 to Length(numeros) do
  begin
    vale := Copy(numeros,i,2);
    vale2 := Copy(numeros,i+1,1);
    if vale2 = '' then
    else
    begin
      total := StrToInt(vale) * StrToInt(vale2);
      resultado := resultado + total;
    end;
  end;

  vale := RightStr(IntToStr(resultado),3);
  resultado := StrToInt(vale);
  coef := resultado div 34;
  resi := resultado mod 34;
  vale2 := '';
  //OBTENEMOS EL PRIMER CARACTAER DE LA HOMOCLAVE SEGUN EL COEFICIENTE
  //DE LA DIVISION ENTRE EL FACTOR 34
  case coef of
    0: vale2 := vale2 + '1';
    1: vale2 := vale2 + '2';
    2: vale2 := vale2 + '3';
    3: vale2 := vale2 + '4';
    4: vale2 := vale2 + '5';
    5: vale2 := vale2 + '6';
    6: vale2 := vale2 + '7';
    7: vale2 := vale2 + '8';
    8: vale2 := vale2 + '9';
    9: vale2 := vale2 + 'A';
    10: vale2 := vale2 + 'B';
    11: vale2 := vale2 + 'C';
    12: vale2 := vale2 + 'D';
    13: vale2 := vale2 + 'E';
    14: vale2 := vale2 + 'F';
    15: vale2 := vale2 + 'G';
    16: vale2 := vale2 + 'H';
    17: vale2 := vale2 + 'I';
    18: vale2 := vale2 + 'J';
    19: vale2 := vale2 + 'K';
    20: vale2 := vale2 + 'L';
    21: vale2 := vale2 + 'M';
    22: vale2 := vale2 + 'N';
    23: vale2 := vale2 + 'P';
    24: vale2 := vale2 + 'Q';
    25: vale2 := vale2 + 'R';
    26: vale2 := vale2 + 'S';
    27: vale2 := vale2 + 'T';
    28: vale2 := vale2 + 'U';
    29: vale2 := vale2 + 'V';
    30: vale2 := vale2 + 'W';
    31: vale2 := vale2 + 'X';
    32: vale2 := vale2 + 'Y';
    33: vale2 := vale2 + 'Z';
  end;

  //OBTENEMOS EL PRIMER CARACTAER DE LA HOMOCLAVE SEGUN EL RESIDUO
  //DE LA DIVISION ENTRE EL FACTOR 34
  case resi of
    0: vale2 := vale2 + '1';
    1: vale2 := vale2 + '2';
    2: vale2 := vale2 + '3';
    3: vale2 := vale2 + '4';
    4: vale2 := vale2 + '5';
    5: vale2 := vale2 + '6';
    6: vale2 := vale2 + '7';
    7: vale2 := vale2 + '8';
    8: vale2 := vale2 + '9';
    9: vale2 := vale2 + 'A';
    10: vale2 := vale2 + 'B';
    11: vale2 := vale2 + 'C';
    12: vale2 := vale2 + 'D';
    13: vale2 := vale2 + 'E';
    14: vale2 := vale2 + 'F';
    15: vale2 := vale2 + 'G';
    16: vale2 := vale2 + 'H';
    17: vale2 := vale2 + 'I';
    18: vale2 := vale2 + 'J';
    19: vale2 := vale2 + 'K';
    20: vale2 := vale2 + 'L';
    21: vale2 := vale2 + 'M';
    22: vale2 := vale2 + 'N';
    23: vale2 := vale2 + 'P';
    24: vale2 := vale2 + 'Q';
    25: vale2 := vale2 + 'R';
    26: vale2 := vale2 + 'S';
    27: vale2 := vale2 + 'T';
    28: vale2 := vale2 + 'U';
    29: vale2 := vale2 + 'V';
    30: vale2 := vale2 + 'W';
    31: vale2 := vale2 + 'X';
    32: vale2 := vale2 + 'Y';
    33: vale2 := vale2 + 'Z';
  end;

  cliente := completo + vale2;
  numeros := '';
  //OBTENEMOS LA SERIE DE NUMEROS CORRESPONDIENTES A NUESTRO NOMBRE
  //TOMANDO ESTOS VALORES DEL ANEXO III
  for i:=1 to Length(cliente) do
  begin
    vale := Copy(cliente,i,1);
    case vale[1] of
          '0': numeros := numeros + '00';
          '1': numeros := numeros + '01';
          '2': numeros := numeros + '02';
          '3': numeros := numeros + '03';
          '4': numeros := numeros + '04';
          '5': numeros := numeros + '05';
          '6': numeros := numeros + '06';
          '7': numeros := numeros + '07';
          '8': numeros := numeros + '08';
          '9': numeros := numeros + '09';
      'A','a': numeros := numeros + '10';
      'B','b': numeros := numeros + '11';
      'C','c': numeros := numeros + '12';
      'D','d': numeros := numeros + '13';
      'E','e': numeros := numeros + '14';
      'F','f': numeros := numeros + '15';
      'G','g': numeros := numeros + '16';
      'H','h': numeros := numeros + '17';
      'I','i': numeros := numeros + '18';
      'J','j': numeros := numeros + '19';
      'K','k': numeros := numeros + '20';
      'L','l': numeros := numeros + '21';
      'M','m': numeros := numeros + '22';
      'N','n': numeros := numeros + '23';
          '&': numeros := numeros + '24';
      'O','o': numeros := numeros + '25';
      'P','p': numeros := numeros + '26';
      'Q','q': numeros := numeros + '27';
      'R','r': numeros := numeros + '28';
      'S','s': numeros := numeros + '29';
      'T','t': numeros := numeros + '30';
      'U','u': numeros := numeros + '31';
      'V','v': numeros := numeros + '32';
      'W','w': numeros := numeros + '33';
      'X','x': numeros := numeros + '34';
      'Y','y': numeros := numeros + '35';
      'Z','z': numeros := numeros + '36';
          ' ': numeros := numeros + '37';
      'Ñ','ñ': numeros := numeros + '38';
    end;
  end;
  //SE TOMA EL VALO DE CADA LETRA SEGUN EL VALOR DEL ANEXO III Y SE APLICA EN LA FORMULA
  //EN FORMA DESCENDENTE DESDE LA POSICION NUMERO 13
  formulados := ((StrToInt(copy(numeros,1,2))*13)+ (StrToInt(copy(numeros,3,2))*12) + (StrToInt(copy(numeros,5,2))*11) +
                (StrToInt(copy(numeros,7,2))*10) + (StrToInt(copy(numeros,9,2))*9) + (StrToInt(copy(numeros,11,2))*8) +
                (StrToInt(copy(numeros,13,2))*7) + (StrToInt(copy(numeros,15,2))*6) + (StrToInt(copy(numeros,17,2))*5) +
                (StrToInt(copy(numeros,19,2))*4) + (StrToInt(copy(numeros,21,2))*3) + (StrToInt(copy(numeros,23,2))*2));

  //Obtener el residuo de la formula entre 11
  formulados := formulados mod 11;
  //SI EL RESIDUO ES MAYOR A 0 SE RESTARA 11 - EL RESIDIO Y EL RESULTADO SERÁ EL DIGITO VERIFICADOR.
  if formulados > 0 then
    cliente := cliente + IntToStr(11 - formulados)
  else
    cliente := cliente + IntToStr(formulados);
  Result := UpperCase(cliente);
end;


Se añadieron algunos comentarios, y reconstrucción del RFC cuando no tienen apellido Materno.
MensajePublicado:
Lun Jul 21, 2014 11:04 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Calcular RFC (Registro Federal del Contribuyente) México Responder citando



Anuncios



Muchísimas gracias por tu aportación.
MensajePublicado:
Jue Jul 31, 2014 5:23 pm
Top of PageVer perfil de usuario
Mostrar mensajes de anteriores:   
Todas las horas son GMT - 1 Horas
Publicar nuevo tema Responder al tema
Foros de discusión » Borland Delphi, Codegear Delphi .Net  

Cambiar a:  
Key
  Puede publicar nuevos temas en este foro
No puede responder a temas en este foro
No puede editar sus mensajes en este foro
No puede borrar sus mensajes en este foro
No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A