Olá galera, nesta
Quick Tips, irei criar uma DLL, apedido do amigo Benedido, que me mandou uma
sugestão para validar CPF e CNPJ, então vamos criar a DLL.
Para
maiores informações sobre DLL veja as outras Quick Tips que desenvolvi.
//www.devmedia.com.br/articles/viewcomp.asp?comp=15450
//www.devmedia.com.br/articles/viewcomp.asp?comp=15451
//www.devmedia.com.br/articles/viewcomp.asp?comp=15452
Para criarmos a DLL.
Menu
File / New / Other / DLL Wizard.
Agora
iremos implementar nossa DLL. Salve a mesma com o nome prj_DLL_CNPJ_CPF, este será o nome da nossa DLL.
library prj_DLL_CNPJ_CPF;
{ Important note about DLL memory
management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are
nested in records and classes. ShareMem is the interface unit to
the
BORLNDMM.DLL shared memory manager, which must be deployed along
with
your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Dialogs,
Classes;
{$R *.res}
{Valida dígito
verificador de CNPJ}
function TestaCGC(Dado : string) :
boolean;stdCall;
var
D1 : array[1..12] of byte;
I, DF1,
DF2, DF3,
DF4, DF5,
DF6, Resto1,
Resto2, PrimeiroDigito,
SegundoDigito
: integer;
begin
Result := true;
if Length(Dado) = 14 then
begin
for I := 1 to 12 do
if Dado[I] in ['0'..'9'] then
D1[I] := StrToInt(Dado[I])
else
Result := false;
if Result then
begin
DF1 := 0;
DF2 := 0;
DF3 := 0;
DF4 := 0;
DF5 := 0;
DF6 := 0;
Resto1 := 0;
Resto2 := 0;
PrimeiroDigito := 0;
SegundoDigito := 0;
DF1 := 5*D1[1] + 4*D1[2] + 3*D1[3] + 2*D1[4] + 9*D1[5] + 8*D1[6] +
7*D1[7] + 6*D1[8] +
5*D1[9] + 4*D1[10] + 3*D1[11] + 2*D1[12];
DF2 := DF1 div 11;
DF3 := DF2 * 11;
Resto1 := DF1 - DF3;
if (Resto1 = 0) or (Resto1 = 1)
then
PrimeiroDigito
:= 0
else
PrimeiroDigito := 11 - Resto1;
DF4
:= 6*D1[1] + 5*D1[2] + 4*D1[3] + 3*D1[4] + 2*D1[5] + 9*D1[6] +
8*D1[7] + 7*D1[8] + 6*D1[9] + 5*D1[10] + 4*D1[11] + 3*D1[12] +
2*PrimeiroDigito;
DF5 := DF4 div 11;
DF6 := DF5 * 11;
Resto2 := DF4 - DF6;
if (Resto2 = 0) or (Resto2 = 1)
then
SegundoDigito
:= 0
else
SegundoDigito := 11 - Resto2;
if
(PrimeiroDigito <> StrToInt(Dado[13])) or
(SegundoDigito <> StrToInt(Dado[14])) then
Result := false;
end;
end
else
if Length(Dado) <> 0 then
Result := false;
end;
{Valida dígito
verificador de CPF}
function TestaCPF(Dado : string) :
boolean;stdCall;
var
D1 : array[1..9] of byte;
I, DF1,
DF2, DF3,
DF4, DF5,
DF6, Resto1,
Resto2, PrimeiroDigito,
SegundoDigito
: integer;
begin
Result := true;
if Length(Dado) = 11 then
begin
for I := 1 to 9 do
if Dado[I] in ['0'..'9'] then
D1[I] := StrToInt(Dado[I])
else
Result := false;
if Result then
begin
DF1 := 0;
DF2 := 0;
DF3 := 0;
DF4 := 0;
DF5 := 0;
DF6 := 0;
Resto1 := 0;
Resto2 := 0;
PrimeiroDigito := 0;
SegundoDigito := 0;
DF1
:= 10*D1[1] + 9*D1[2] + 8*D1[3] + 7*D1[4] + 6*D1[5] + 5*D1[6] +
4*D1[7] + 3*D1[8] +
2*D1[9];
DF2 := DF1 div 11;
DF3 := DF2 * 11;
Resto1 := DF1 - DF3;
if (Resto1 = 0) or (Resto1 = 1)
then
PrimeiroDigito
:= 0
else
PrimeiroDigito := 11 - Resto1;
DF4
:= 11*D1[1] + 10*D1[2] + 9*D1[3] + 8*D1[4] + 7*D1[5] + 6*D1[6] +
5*D1[7] + 4*D1[8] + 3*D1[9] + 2*PrimeiroDigito;
DF5
:= DF4 div 11;
DF6
:= DF5 * 11;
Resto2 := DF4 - DF6;
if
(Resto2 = 0) or (Resto2 = 1) then
SegundoDigito := 0
else
SegundoDigito := 11 - Resto2;
if
(PrimeiroDigito <> StrToInt(Dado[10])) or
(SegundoDigito <> StrToInt(Dado[11])) then
Result := false;
end;
end
else
if Length(Dado) <> 0 then
Result := false;
end;
{Validar a CPF e
CNPJ, esta é a função que iremos executar em nossa aplicação}
function TestaCpfCgc(Dado: string): String;
stdCall;
var
i: integer;
begin
for
i:= 1 to length(Dado) do begin
if
not (Dado[i] in ['0'..'9']) then delete(Dado,i,1);
end;
if
((length(Dado) <> 11) and (length(Dado) <> 14))then
MessageDlg('ATENÇÃO:
O número informado NÃO representa' + #13 +
'um
CPF ou CGC válido pelas regras da Receita Federal',mtWarning,[mbOK],0);
if length(Dado) = 14 then begin
if TestaCGC(Dado) then begin
insert('-',Dado,13);
insert('/',Dado,9);
insert('.',Dado,6);
insert('.',Dado,3);
end
else
MessageDlg('O número informado NÃO representa um CGC' + #13 +
'válido pelas regras da Receita Federal', mtWarning, [mbOK], 0);
end;
if
length(Dado) = 11 then begin
if TestaCPF(Dado) then begin
insert('-',Dado,10);
insert('.',Dado,7);
insert('.',Dado,4);
end
else
MessageDlg('O número informado NÃO representa um CPF' + #13 +
'válido pelas regras da Receita Federal', mtWarning, [mbOK], 0);
end;
Result := Dado;
end;
exports
{
Exportamos
somenet a Function TestaCPFCGC, pois esta é quem irá validar, as demais não
precisam ser exportadas pois não serão usadas.
}
TestaCpfCgc;
begin
end.
//Fim da implementação da DLL
Fico por aqui ate à
próxima Quick Tips, onde veremos como consumir esta DLL.
Um abraço
Wesley Y
wesley@lithic.com.br
