ROTINA DE VERIFICAÇÃO DE CPF

06/02/2003

2

Alguem pode me passar DENOVO a rotina do CPF?

Muito Obrigado.


Anonymous

Anonymous

Responder

Posts

06/02/2003

Skaarj

function Tfrm_cad_clientes.Cpf(num:string):boolean;
//campo CPF 11 digito sem mascaras [maxlenght 11]
var
n1,n2,n3,n4,n5,n6,n7,n8,n9:integer;
d1,d2:integer;
digitado,calculado:STRING;
begin
try
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;
except
end;
end;


Responder

06/02/2003

Dor_poa

Function TPrincipal.Verifica_CGCCPF(CODIGO:STRING):BOOLEAN;
Var Dig:Array[1..20] of INTEGER;
Digito1,Digito2,CONT_FOR:Integer;
Begin
Result := True ;
try
FOR CONT_FOR := 1 TO 20 DO
DIG[CONT_FOR] := 0;
DIGITO1 := 0;
DIGITO2 := 0;

IF LENGTH(CODIGO)=18 THEN
BEGIN
FOR CONT_FOR := 1 TO 18 DO
BEGIN
IF (COPY(codigo, CONT_FOR, 1) <> ´.´) AND
(COPY(codigo, CONT_FOR, 1) <> ´,´) AND
(COPY(codigo, CONT_FOR, 1) <> ´/´) AND
(COPY(codigo, CONT_FOR, 1) <> ´-´) THEN
DIG[CONT_FOR] := STRTOINT(COPY(codigo, CONT_FOR, 1)) ;
END;
DIG[1] := DIG[1] * 5;
DIG[2] := DIG[2] * 4;
DIG[4] := DIG[4] * 3;
DIG[5] := DIG[5] * 2;
DIG[6] := DIG[6] * 9;
DIG[8] := DIG[8] * 8;
DIG[9] := DIG[9] * 7;
DIG[10] := DIG[10] * 6;
DIG[12] := DIG[12] * 5;
DIG[13] := DIG[13] * 4;
DIG[14] := DIG[14] * 3;
DIG[15] := DIG[15] * 2;
FOR CONT_FOR := 1 TO 15 DO
DIG[19] := DIG[19] + DIG[CONT_FOR];

DIGITO1 := Trunc(DIG[19] / 11);
DIGITO1 := DIGITO1 * 11;
DIGITO1 := DIG[19] - DIGITO1;
DIGITO1 := 11 - DIGITO1;

IF DIGITO1 >= 10 THEN DIGITO1 := 0;
IF DIGITO1 <> DIG[17] THEN
BEGIN
Showmessage(´CNPJ/CPF inválido´);
Verifica_CGCCPF:=FALSE;
Exit;
END;

FOR CONT_FOR := 1 TO 18 DO
BEGIN
IF (COPY(codigo, CONT_FOR, 1) <> ´.´) AND
(COPY(codigo, CONT_FOR, 1) <> ´/´) AND
(COPY(codigo, CONT_FOR, 1) <> ´-´) THEN
DIG[CONT_FOR] := STRTOINT(COPY(codigo, CONT_FOR, 1)) ;
END;
DIG[1] := DIG[1] * 6;
DIG[2] := DIG[2] * 5;
DIG[4] := DIG[4] * 4;
DIG[5] := DIG[5] * 3;
DIG[6] := DIG[6] * 2;
DIG[8] := DIG[8] * 9;
DIG[9] := DIG[9] * 8;
DIG[10] := DIG[10] * 7;
DIG[12] := DIG[12] * 6;
DIG[13] := DIG[13] * 5;
DIG[14] := DIG[14] * 4;
DIG[15] := DIG[15] * 3;
DIG[17] := DIG[17] * 2;
FOR CONT_FOR := 1 TO 17 DO
DIG[20] := DIG[20] + DIG[CONT_FOR];

DIGITO2 := trunc(DIG[20] / 11);
DIGITO2 := DIGITO2 * 11;
DIGITO2 := DIG[20] - DIGITO2;
DIGITO2 := 11 - DIGITO2;

IF DIGITO2 >= 10 THEN DIGITO2 := 0;
IF DIGITO2 <> DIG[18] THEN
BEGIN
SHOWMESSAGE(´Cnpj inválido´);
Verifica_CGCCPF:=FALSE;
Exit;
END;
END

//** comeca a testar i cpf ********
ELSE BEGIN // Testar CPF
FOR CONT_FOR := 1 TO 14 DO
BEGIN
IF (COPY(codigo, CONT_FOR, 1) <> ´.´) AND
(COPY(codigo, CONT_FOR, 1) <> ´/´) AND
(COPY(codigo, CONT_FOR, 1) <> ´-´) THEN
DIG[CONT_FOR] := STRTOINT(COPY(codigo, CONT_FOR, 1)) ;
END;
DIG[1] := DIG[1] * 10;
DIG[2] := DIG[2] * 9;
DIG[3] := DIG[3] * 8;
DIG[5] := DIG[5] * 7;
DIG[6] := DIG[6] * 6;
DIG[7] := DIG[7] * 5;
DIG[9] := DIG[9] * 4;
DIG[10] := DIG[10] * 3;
DIG[11] := DIG[11] * 2;
FOR CONT_FOR := 1 TO 11 DO
DIG[19] := DIG[19] + DIG[CONT_FOR];

DIGITO1 := Trunc(DIG[19] / 11);
DIGITO1 := DIGITO1 * 11;
DIGITO1 := DIG[19] - DIGITO1;
DIGITO1 := 11 - DIGITO1;

IF DIGITO1 >= 10 THEN DIGITO1 := 0;
IF DIGITO1 <> DIG[13] THEN
BEGIN
SHOWMESSAGE(´Cpf Inválido´);
Verifica_CGCCPF:=FALSE;
Exit;
END;
FOR CONT_FOR := 1 TO 14 DO
BEGIN
IF (COPY(codigo, CONT_FOR, 1) <> ´.´) AND
(COPY(codigo, CONT_FOR, 1) <> ´-´) THEN
DIG[CONT_FOR] := STRTOINT(COPY(codigo, CONT_FOR, 1)) ;
END;
DIG[1] := DIG[1] * 11;
DIG[2] := DIG[2] * 10;
DIG[3] := DIG[3] * 9;
DIG[5] := DIG[5] * 8;
DIG[6] := DIG[6] * 7;
DIG[7] := DIG[7] * 6;
DIG[9] := DIG[9] * 5;
DIG[10] := DIG[10] * 4;
DIG[11] := DIG[11] * 3;
DIG[13] := DIG[13] * 2;
FOR CONT_FOR := 1 TO 13 DO
DIG[20] := DIG[20] + DIG[CONT_FOR];

DIGITO2 := trunc(DIG[20] / 11);
DIGITO2 := DIGITO2 * 11;
DIGITO2 := DIG[20] - DIGITO2;
DIGITO2 := 11 - DIGITO2;

IF DIGITO2 >= 10 THEN DIGITO2 := 0;
IF DIGITO2 <> DIG[14] THEN
BEGIN
SHOWMESSAGE(´Cpf Inválido´);
Verifica_CGCCPF:=FALSE;
Exit;
END;
Result := True;
END;
except
SHOWMESSAGE(´Nº de caracteres inválido!´);
Result := False;
end;
end;


Responder

06/02/2003

Moonlight

Eu tenho essa function. Trata espacos, pontos, tracinhos.... retorna verdadeiro se os digitos finais estiverem certos ou falso se estiverem errados.


function VerificaCPF(CPF:string):boolean;
var
i,soma,peso,digito:integer;
begin
CPF:=trim(CPF); //funcao para tirar espacos do inicio e final da string
CPF:=StringReplace(CPF,´-´,´´,[rfReplaceAll]);
CPF:=StringReplace(CPF,´.´,´´,[rfReplaceAll]);
//as funcoes acima substituem os caracteres - e ., respectivamente, por nada (ou seja, tiram)
result:=length(CPF)=11;
//result recebe o valor logico da comparacao: o tamanho do CPF é de 11 caracteres?
if result then //se for, entao vai verificar o primeiro digito
begin
soma:=0;
peso:=10;
for i:=1 to 9 do
begin
soma:=soma + StrtoInt(CPF[i])*peso;//calculo do digito
peso:=peso-1;//decremento do peso
end;
digito:=soma mod 11; //digito recebe o resto
if digito<2 then //se resto <2, digito vai ser 0
digito:=0
else
digito:=11-digito; //senao, digito vai ser 11-resto (q estava armazenado em digito)
result:=(digito=StrToInt(CPF[10])); //compara se o digito encontrado eh igual ao que estah lah
if result then //se for, vai calcular o segundo digito
begin
soma:=0;
peso:=11;
for i:=1 to 10 do
begin //inicia-se o calculo do segundo digito
soma:=soma+StrToInt(CPF[i])*peso;
peso:=peso-1;
end;
digito:=soma mod 11; //digito recebe o resto
if digito<2 then //se resto <2, digito vai ser 0
digito:=0
else
digito:=11-digito; //senao, digito vai ser 11-resto (q estava armazenado em digito)
result:=(digito=StrToInt(CPF[11]));//verifica se o digito encontrado eh igual ao que estah lah
end;
end;
end;


Responder

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

Aceitar