GARANTIR DESCONTO

Fórum CPF #198108

01/12/2003

0

Peguei este código aqui no site em dicas & macetes mas não entendi direito. Tenho um edit onde o usuário vai digitar o cpf, como devo fazer para passar o que estiver escrito nesse edit para que a função faça a validação. Como será para dar a mensagem de CPF válido ou inválido?

function cpf(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
d1:=n9*2+n8*3+n7*4+n6*5+n5*6+n4*7+n3*8+n2*9+n1*10;
d1:=11-(d1 mod 11);
if d1>=10 then
d1:=0;
d2:=d1*2+n9*3+n8*4+n7*5+n6*6+n5*7+n4*8+n3*9+n2*10+n1*11;
d2:=11-(d2 mod 11);
if d2>=10 then
d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[10]+num[11];
if calculado=digitado then
cpf:=true
else
cpf:=false;
end;

Valeu


Barbara.michele

Barbara.michele

Responder

Posts

01/12/2003

Rafael Mattos

Nesse Caso Vc teria que fazer isso----->

if not CPF(NomeEdit.Text) then begin
MessageDlg(´CPF Incorreto´,mtInformation,[mbOK],0);
NomeEdit.SetFocus;
end;


Responder

Gostei + 0

01/12/2003

Barbara.michele

Mas e para passar o (NomeEdit.Text) para a função para poder fazer o cálculo?
Esse código que escreveu, posso usar no BeforePost da tabela?
E se no meu edit estiver o CPF com uma máscara (. - /), dará algum problema na hora de fazer o cálculo?

Valeu pela ajuda.


Responder

Gostei + 0

01/12/2003

Anjo Mal

É melhor você passar no OnExit de (NomeEdit.Text), e a mascara só dará problema se você estiver salvando no BD com elas ou seja, se a opção Save Literal Caracters estiver marcada. Neste caso você tera que mudar a função para pular esses caracteres, fazendo o seguinte nesta parte da função:

n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[5]);
n5:=StrToInt(num[6]);
n6:=StrToInt(num[7]);
n7:=StrToInt(num[9]);
n8:=StrToInt(num[10]);
n9:=StrToInt(num[11]);

Veja que eu pulei os caracteres da mascara. Espero ter ajudado.


Responder

Gostei + 0

01/12/2003

Perin75

.: Diversos :> Algoritimos Comuns


// Calculo CNPJ, CPF e I.E. de todos os estados.



Unit Inscricoes;


Interface uses

Sysutils;

Function Inscricao( Inscricao, Tipo : String ) : Boolean;

Implementation

{ Inscriçoes # }

Function Inscricao( Inscricao, 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

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 }
{ I = 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 i 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 = ´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 IF Pos( Copy( Inscricao, Contador, 1 ), ´0123456789´ ) <> 0 Then Base_1 := Base_1 + Copy( Inscricao, Contador, 1 );

{ 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çoes }

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;
Modulo := 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çao }

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( Inscricao ) = ´ISENTO´ Then Retorno := TRUE;

Result := Retorno;

Except On EConvertError Do

Result := False;

End;

End;

{ # }

End.


Responder

Gostei + 0

01/12/2003

Barbara.michele

Desabilitei a opção Save Literal Characters para poder fazer a validação do CPF, ele salvará na tabela sem a máscara.
Mas no quickreport quero que exiba com a máscara. Como faço?
Em alguns relatórios uso o QRDBText e em outros uso o QRExpr.


Responder

Gostei + 0

06/12/2003

Barbara.michele

Tem como fazer para o QRDBText e o QRExp exibirem um número de CNPJ ou CPF com uma máscara com os pontos e barra. No meu banco esses números são gravados sem máscara.
Usei a propriedade mask desses componentes mas não deu certo.
O que posso fazer???

Valeu.


Responder

Gostei + 0

06/12/2003

Jose Almeida

Após colar o código que você possui no devido local,
no Evento OnExit de seu Edit, faça como neste exemplo:


[color=green:692cdd76a5]procedure TForm1.Edit1Exit(Sender: TObject);
begin
if CPF(Edit1.text) = False then
ShowMessage(´CPF INVÁLIDO´) else
ShowMessage(´CPF VÁLIDO´); //Substitua esta linha pelo seu código;
end;[/color:692cdd76a5]


Responder

Gostei + 0

06/12/2003

Jose Almeida

Para fazer com que o Edit (do cpf) só aceite números faça como abaixo:

[color=green:a7de6fdc4e]procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not ( Key In [´0´..´9´,#8] ) then
Abort;
end;[/color:a7de6fdc4e]


Responder

Gostei + 0

07/12/2003

Barbara.michele

Valeu por todas as dicas mas o que tenho que fazer é no QuickReport.
O QRDBText e o QRExp exibem o número do CPF ou CNPJ, porém como estou gravando no banco sem a máscara que aparece na hora do cadastro, quando vou exibir esses dados no relatório eles também aparecem sem máscara. Quero exibir esses dois campos com os pontos e barras (máscaras).
Usei a propriedade mask desses componentes mas não deu certo.


Responder

Gostei + 0

07/12/2003

Jose Almeida

Você pode usal algo assim para restaurar o formato do cpf:

[color=green:0bc2d4478a]Edit1:=Copy(CPF,1,3)+´.´+Copy(CPF,4,3)+´.´+Copy(CPF,7,3)+´-´+Copy(CPF,10,2);[/color:0bc2d4478a]


Responder

Gostei + 0

09/12/2003

Rolemes

Olá eu tenho duas funções que poderão te ajudar, uma é de validação de cpf(que acho que seja mais simples que essa que vc tem) e outra é de inserir caracteres em uma palavra qualquer, por exemplo o cpf é:047.123.325-14 e vc digita 04712332514 a prórpia função faz o trabalho de separar os caracteres e inserir qualquer outro no lugar que vc quizer.

se achar que te ajudará, basta me mandar um e-mail:rogenio@serparh.com.br


Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar