Validar inscrição estadual - Atualizado para o Estado de PE
Código
function funChecaIE(IE, TIPO: string): Boolean;
var
Contador: ShortInt;
Casos: ShortInt;
Digitos: ShortInt;
Tabela_1: string;
Tabela_2: string;
Tabela_3: string;
Base_1: string;
Base_2: string;
Base_3: string;
Valor_1: ShortInt;
Soma_1: Integer;
Soma_2: Integer;
Erro_1: ShortInt;
Erro_2: ShortInt;
Erro_3: ShortInt;
Posicao_1: string;
Posicao_2: string;
Tabela: string;
Rotina: string;
Modulo: ShortInt;
Peso: string;
Digito: ShortInt;
Resultado: string;
Retorno: Boolean;
begin
{ Isento ja e aceito }
if (IE = 'ISENTO') or (Trim(IE) = '') then
begin
Result := True;
Exit;
end;
{ Inscrição de produtor rural, não validar }
if (Copy(IE, 1, 2) = 'PR') then
begin
Result := True;
Exit;
end;
try
Tabela_1 := ' ';
Tabela_2 := ' ';
Tabela_3 := ' ';
{ }
{ }
{ Valores possiveis para os digitos (j) }
{ }
{ 0 a 9 = Somente o digito indicado. }
{ N = Numeros 0 1 2 3 4 5 6 7 8 ou 9 }
{ A = Numeros 1 2 3 4 5 6 7 8 ou 9 }
{ B = Numeros 0 3 5 7 ou 8 }
{ C = Numeros 4 ou 7 }
{ D = Numeros 3 ou 4 }
{ E = Numeros 0 ou 8 }
{ F = Numeros 0 1 ou 5 }
{ G = Numeros 1 7 8 ou 9 }
{ H = Numeros 0 1 2 ou 3 }
{ if = Numeros 0 1 2 3 ou 4 }
{ J = Numeros 0 ou 9 }
{ K = Numeros 1 2 3 ou 9 }
{ }
{ ----------------------------------------------------------------------------- }
{ }
{ Valores possiveis para as rotinas (d) e (g) }
{ }
{ A a E = Somente a Letra indicada. }
{ 0 = B e D }
{ 1 = C e E }
{ 2 = A e E }
{ }
{ ----------------------------------------------------------------------------- }
{ }
{ C T F R M P R M P }
{ A A A O O E O O E }
{ S M T T D S T D S }
{ }
{ a b c d e f g h if jjjjjjjjjjjjjj }
{ 0000000001111111111222222222233333333 }
{ 1234567890123456789012345678901234567 }
if TIPO = 'AC' Then Tabela_1 := '1.09.0.E.11.01. . . . 01NNNNNNX.14.00';
if TIPO = 'AC' Then Tabela_2 := '2.13.0.E.11.02.E.11.01. 01NNNNNNNNNXY.13.14';
IF TIPO = 'AL' Then Tabela_1 := '1.09.0.0.11.01. . . . 24BNNNNNX.14.00';
IF TIPO = 'AP' Then Tabela_1 := '1.09.0.1.11.01. . . . 03NNNNNNX.14.00';
IF TIPO = 'AP' Then Tabela_2 := '2.09.1.1.11.01. . . . 03NNNNNNX.14.00';
IF TIPO = 'AP' Then Tabela_3 := '3.09.0.E.11.01. . . . 03NNNNNNX.14.00';
IF TIPO = 'AM' Then Tabela_1 := '1.09.0.E.11.01. . . . 0CNNNNNNX.14.00';
IF TIPO = 'BA' Then Tabela_1 := '1.08.0.E.10.02.E.10.03. NNNNNNYX.14.13';
IF TIPO = 'BA' Then Tabela_2 := '2.08.0.E.11.02.E.11.03. NNNNNNYX.14.13';
IF TIPO = 'CE' Then Tabela_1 := '1.09.0.E.11.01. . . . 0NNNNNNNX.14.13';
IF TIPO = 'DF' Then Tabela_1 := '1.13.0.E.11.02.E.11.01. 07DNNNNNNNNXY.13.14';
IF TIPO = 'ES' Then Tabela_1 := '1.09.0.E.11.01. . . . 0ENNNNNNX.14.00';
IF TIPO = 'GO' Then Tabela_1 := '1.09.1.E.11.01. . . . 1FNNNNNNX.14.00';
IF TIPO = 'GO' Then Tabela_2 := '2.09.0.E.11.01. . . . 1FNNNNNNX.14.00';
IF TIPO = 'MA' Then Tabela_1 := '1.09.0.E.11.01. . . . 12NNNNNNX.14.00';
IF TIPO = 'MT' Then Tabela_1 := '1.11.0.E.11.01. . . . NNNNNNNNNNX.14.00';
IF TIPO = 'MS' Then Tabela_1 := '1.09.0.E.11.01. . . . 28NNNNNNX.14.00';
IF TIPO = 'MG' Then Tabela_1 := '1.13.0.2.10.10.E.11.11. NNNNNNNNNNNXY.13.14';
IF TIPO = 'PA' Then Tabela_1 := '1.09.0.E.11.01. . . . 15NNNNNNX.14.00';
IF TIPO = 'PB' Then Tabela_1 := '1.09.0.E.11.01. . . . 16NNNNNNX.14.00';
IF TIPO = 'PR' Then Tabela_1 := '1.10.0.E.11.09.E.11.08. NNNNNNNNXY.13.14';
IF TIPO = 'PE' Then Tabela_1 := '1.14.1.E.11.07. . . .18ANNNNNNNNNNX.14.00';
IF TIPO = 'PE' Then Tabela_2 := '2.09.0.E.11.07.E.11.02. NNNNNNNYX.14.13';
IF TIPO = 'PI' Then Tabela_1 := '1.09.0.E.11.01. . . . 19NNNNNNX.14.00';
IF TIPO = 'RJ' Then Tabela_1 := '1.08.0.E.11.08. . . . GNNNNNNX.14.00';
IF TIPO = 'RN' Then Tabela_1 := '1.09.0.0.11.01. . . . 20HNNNNNX.14.00';
IF TIPO = 'RS' Then Tabela_1 := '1.10.0.E.11.01. . . . INNNNNNNNX.14.00';
IF TIPO = 'RO' Then Tabela_1 := '1.09.1.E.11.04. . . . ANNNNNNNX.14.00';
IF TIPO = 'RO' Then Tabela_2 := '2.14.0.E.11.01. . . .NNNNNNNNNNNNNX.14.00';
IF TIPO = 'RR' Then Tabela_1 := '1.09.0.D.09.05. . . . 24NNNNNNX.14.00';
IF TIPO = 'SC' Then Tabela_1 := '1.09.0.E.11.01. . . . NNNNNNNNX.14.00';
IF TIPO = 'SP' Then Tabela_1 := '1.12.0.D.11.12.D.11.13. NNNNNNNNXNNY.11.14';
IF TIPO = 'SP' Then Tabela_2 := '2.12.0.D.11.12. . . . NNNNNNNNXNNN.11.00';
IF TIPO = 'SE' Then Tabela_1 := '1.09.0.E.11.01. . . . NNNNNNNNX.14.00';
IF TIPO = 'TO' Then Tabela_1 := '1.11.0.E.11.06. . . . 29JKNNNNNNX.14.00';
IF TIPO = 'CNPJ' Then Tabela_1 := '1.14.0.E.11.21.E.11.22.NNNNNNNNNNNNXY.13.14';
IF TIPO = 'CPF' Then Tabela_1 := '1.11.0.E.11.31.E.11.32. NNNNNNNNNXY.13.14';
{ Deixa somente os numeros }
Base_1 := '';
for Contador := 1 to 30 do
begin
if Pos(Copy(IE, Contador, 1), '0123456789') <> 0 then
Base_1 := Base_1 + Copy(IE, Contador, 1);
end;
{ Repete 3x - 1 para cada caso possivel }
Casos := 0;
Erro_1 := 0;
Erro_2 := 0;
Erro_3 := 0;
while Casos < 3 do
begin
Casos := Casos + 1;
IF Casos = 1 Then Tabela := Tabela_1;
IF Casos = 2 Then Erro_1 := Erro_3 ;
IF Casos = 2 Then Tabela := Tabela_2;
IF Casos = 3 Then Erro_2 := Erro_3 ;
IF Casos = 3 Then Tabela := Tabela_3;
Erro_3 := 0;
if Copy(Tabela, 1, 1) <> ' ' then
begin
{ Verifica o Tamanho }
if Length(Trim(Base_1)) <> (StrToInt(Copy(Tabela, 3, 2))) then
Erro_3 := 1;
if Erro_3 = 0 then
begin
{ Ajusta o Tamanho }
Base_2 := Copy(' ' + Base_1, Length(' ' + Base_1) - 13, 14);
{ Compara com valores possivel para cada uma da 14 posições }
Contador := 0;
while (Contador < 14) and (Erro_3 = 0) do
begin
Contador := Contador + 1;
Posicao_1 := Copy(Copy(Tabela, 24, 14), Contador, 1);
Posicao_2 := Copy(Base_2, Contador, 1);
IF ( Posicao_1 = ' ' ) AND ( Posicao_2 <> ' ' ) Then Erro_3 := 1;
IF ( Posicao_1 = 'N' ) AND ( Pos( Posicao_2, '0123456789' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'A' ) AND ( Pos( Posicao_2, '123456789' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'B' ) AND ( Pos( Posicao_2, '03578' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'C' ) AND ( Pos( Posicao_2, '47' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'D' ) AND ( Pos( Posicao_2, '34' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'E' ) AND ( Pos( Posicao_2, '08' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'F' ) AND ( Pos( Posicao_2, '015' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'G' ) AND ( Pos( Posicao_2, '1789' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'H' ) AND ( Pos( Posicao_2, '0123' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'I' ) AND ( Pos( Posicao_2, '01234' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'J' ) AND ( Pos( Posicao_2, '09' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 = 'K' ) AND ( Pos( Posicao_2, '1239' ) = 0 ) Then Erro_3 := 1;
IF ( Posicao_1 <> Posicao_2 ) AND ( Pos( Posicao_1, '0123456789' ) > 0 ) Then Erro_3 := 1;
end;
{ Calcula os Digitos }
Rotina := ' ';
Digitos := 000;
Digito := 000;
while (Digitos < 2) and (Erro_3 = 0) do
begin
Digitos := Digitos + 1;
{ Carrega peso }
Peso := Copy(Tabela, 5 + (Digitos * 8), 2);
if Peso <> ' ' then
begin
Rotina := Copy(Tabela, 0 + (Digitos * 8), 1);
Modulo := StrToInt(Copy(Tabela, 2 + (Digitos * 8), 2));
IF Peso = '01' Then Peso := '06.05.04.03.02.09.08.07.06.05.04.03.02.00';
IF Peso = '02' Then Peso := '05.04.03.02.09.08.07.06.05.04.03.02.00.00';
IF Peso = '03' Then Peso := '06.05.04.03.02.09.08.07.06.05.04.03.00.02';
IF Peso = '04' Then Peso := '00.00.00.00.00.00.00.00.06.05.04.03.02.00';
IF Peso = '05' Then Peso := '00.00.00.00.00.01.02.03.04.05.06.07.08.00';
IF Peso = '06' Then Peso := '00.00.00.09.08.00.00.07.06.05.04.03.02.00';
IF Peso = '07' Then Peso := '05.04.03.02.01.09.08.07.06.05.04.03.02.00';
IF Peso = '08' Then Peso := '08.07.06.05.04.03.02.07.06.05.04.03.02.00';
IF Peso = '09' Then Peso := '07.06.05.04.03.02.07.06.05.04.03.02.00.00';
IF Peso = '10' Then Peso := '00.01.02.01.01.02.01.02.01.02.01.02.00.00';
IF Peso = '11' Then Peso := '00.03.02.11.10.09.08.07.06.05.04.03.02.00';
IF Peso = '12' Then Peso := '00.00.01.03.04.05.06.07.08.10.00.00.00.00';
IF Peso = '13' Then Peso := '00.00.03.02.10.09.08.07.06.05.04.03.02.00';
IF Peso = '21' Then Peso := '05.04.03.02.09.08.07.06.05.04.03.02.00.00';
IF Peso = '22' Then Peso := '06.05.04.03.02.09.08.07.06.05.04.03.02.00';
IF Peso = '31' Then Peso := '00.00.00.10.09.08.07.06.05.04.03.02.00.00';
IF Peso = '32' Then Peso := '00.00.00.11.10.09.08.07.06.05.04.03.02.00';
{ Multiplica }
Base_3 := Copy(('0000000000000000' + Trim(Base_2)), Length(('0000000000000000' + Trim(Base_2))) - 13, 14);
Soma_1 := 0;
Soma_2 := 0;
for Contador := 1 to 14 do
begin
Valor_1 := (StrToInt(Copy(Base_3, Contador, 01)) * StrToInt(Copy(Peso, Contador * 3 - 2, 2)));
Soma_1 := Soma_1 + Valor_1;
if Valor_1 > 9 then
Valor_1 := Valor_1 - 9;
Soma_2 := Soma_2 + Valor_1;
end;
{ Ajusta valor da soma }
IF Pos( Rotina, 'A2' ) > 0 Then Soma_1 := Soma_2;
IF Pos( Rotina, 'B0' ) > 0 Then Soma_1 := Soma_1 * 10;
IF Pos( Rotina, 'C1' ) > 0 Then Soma_1 := Soma_1 + ( 5 + 4 * StrToInt( Copy( Tabela, 6, 1 ) ) );
{ Calcula o Digito }
IF Pos( Rotina, 'D0' ) > 0 Then Digito := Soma_1 Mod Modulo;
IF Pos( Rotina, 'E12' ) > 0 Then Digito := Modulo - ( Soma_1 Mod Modulo);
IF Digito < 10 Then Resultado := IntToStr( Digito );
IF Digito = 10 Then Resultado := '0';
IF Digito = 11 Then Resultado := Copy( Tabela, 6, 1 );
{ Verifica o Digito }
if (Copy(Base_2, StrToInt(Copy(Tabela, 36 + (Digitos * 3), 2)), 1) <> Resultado) then
Erro_3 := 1;
end;
end;
end;
end;
end;
{ Retorna o resultado da Verificação }
Retorno := FALSE;
if (Trim(Tabela_1) <> '') and (ERRO_1 = 0) then Retorno := TRUE;
if (Trim(Tabela_2) <> '') and (ERRO_2 = 0) then Retorno := TRUE;
if (Trim(Tabela_3) <> '') and (ERRO_3 = 0) then Retorno := TRUE;
if Trim(IE) = 'ISENTO' then Retorno := TRUE;
Result := Retorno;
except
Result := False;
end;
end;
Publicidade
Vote na dica
Quantidade de votos: 1 voto
Aceitação: 20%
Detalhes da dica
Adicionada dia: 16/09/09
Por: Isaque Pinheiro
Visualizada: 4441 vezes
Publicidade
Enquete
O que achou do novo site?
Planeta Delphi - www.planetadelphi.com.br - Todos os direitos reservados | Copyright 2001-2009