Salve salve amigos,
Muitos ainda desconhecem, mas o Delphi possui várias funções pré-definidas para manipulação de datas. A maioria delas se encontra na unit DateUtils, mas existem também algumas da unit SysUtils.
O Delphi lhe dará uma lista de todas as funções disponíveis. Entre algumas das que considero mais úteis estão:
- retorna o número de horas entre 2 horários
function HourSpan(const ANow: TDateTime; const AThen: TDateTime): Double;
- número de anos entre 2 datas
function YearSpan(const ANow: TDateTime; const AThen: TDateTime): Double;
- extrai o dia de uma data
function DayOf(const AValue: TDateTime): Word;
- extrai o mês de uma data
function MonthOf(const AValue: TDateTime): Word;
- extrai o ano de uma data
function YearOf(const AValue: TDateTime): Word;
- extrai a hora
function HourOf(const AValue: TDateTime): Word;
- extrai o minuto
function MinuteOf(const AValue: TDateTime): Word;
- extrai o segundo
function SecondOf(const AValue: TDateTime): Word;
Ainda há certos detalhes a serem observados. É importante tomar cuidado e ler a ajuda do delphi antes de usar a função para ter certeza do resultado. Por exemplo, a unit dateutils possui esta função:
function DayOfTheWeek(const AValue: TDateTime): Word;
Ela retorna o dia da semana, mas considerando que a semana começa por segunda-feira (1 = segunda, 2 = terça ... 7 = domingo). Já a unit sysutils possui a seguinte função:
function DayOfWeek(const AValue: TDateTime): Word;
Esta função faz a mesma coisa, retorna o dia da semana, mas considerando o domingo como primeiro dia (1 = domingo, 2 = segunda ... 7 = sábado)!
Outra função, muito útil, mas que não está disponível em dateutils, mas sim em sysutils:
function IncMonth(const DateTime: TDateTime; NumberOfMonths: Integer): TDateTime;
Esta função soma ou subtrai meses de uma data. Exemplos:
IncMonth(25/10/2008, 1) = 25/11/2008
IncMonth(25/10/2008,-1) = 25/09/2008
IncMonth(25/10/2008, 2) = 25/12/2008
Take care
sexta-feira, 19 de fevereiro de 2010
Captura o Usuário Logado no Windows
Salve salve amigos,
Veja nesta dica uma pequena e simples função que é capaz de retornar o nome do usuário logado no Windows. Pode ser muito útil, por exemplo, para incrementar a gravação de logs das operações de seu sistema.
// Função para capturar o usuário logado no windows:
Function GetNetUserName: string;
Var
NetUserNameLength: DWord;
Begin
NetUserNameLength := 50;
SetLength(Result, NetUserNameLength);
GetUserName(pChar(Result), NetUserNameLength);
SetLength(Result, StrLen(pChar(Result)));
End;
// Para visualizar, basta fazer, por exemplo:
Edit1.text := GetNetUserName;
Take care
Veja nesta dica uma pequena e simples função que é capaz de retornar o nome do usuário logado no Windows. Pode ser muito útil, por exemplo, para incrementar a gravação de logs das operações de seu sistema.
// Função para capturar o usuário logado no windows:
Function GetNetUserName: string;
Var
NetUserNameLength: DWord;
Begin
NetUserNameLength := 50;
SetLength(Result, NetUserNameLength);
GetUserName(pChar(Result), NetUserNameLength);
SetLength(Result, StrLen(pChar(Result)));
End;
// Para visualizar, basta fazer, por exemplo:
Edit1.text := GetNetUserName;
Take care
Converter Minutos Para Horas
Salve salve amigos,
Veja nesta dica uma simples função que retorna a quantidade de horas a partir de uma quantidade de minutos.
function MinutosEmHoras(Minutos: Integer): String;
var
HoraDecimal, HH, MM: String;
begin
if Minutos > 1440 then
Minutos := Minutos - 1440;
HoraDecimal := FormatFloat( '00.00', Minutos / 60 );
HH := Copy( HoraDecimal, 1 , 2 );
if Copy( HoraDecimal, 4, 5 )[1] = '0' then
MM := '0' + IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) )
else
MM := IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) );
Result := HH+ ':' + MM ;
end;
Para utilizá-la, faça:
ShowMessage( MinutosEmHoras(480) );
//retornará: '08:00'
Take care
Veja nesta dica uma simples função que retorna a quantidade de horas a partir de uma quantidade de minutos.
function MinutosEmHoras(Minutos: Integer): String;
var
HoraDecimal, HH, MM: String;
begin
if Minutos > 1440 then
Minutos := Minutos - 1440;
HoraDecimal := FormatFloat( '00.00', Minutos / 60 );
HH := Copy( HoraDecimal, 1 , 2 );
if Copy( HoraDecimal, 4, 5 )[1] = '0' then
MM := '0' + IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) )
else
MM := IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) );
Result := HH+ ':' + MM ;
end;
Para utilizá-la, faça:
ShowMessage( MinutosEmHoras(480) );
//retornará: '08:00'
Take care
Criptografia Simples
Salve, salve amigos
Essa é uma rotina de criptografia simples. Pode ser útil a você, mas lembrando, é uma criptografia simples.
function ECripta(Dado : String) : String;
var
mensx : String;
l, i, j : integer;
begin
j := 0;
mensx := '';
for i := 1 to length(Dado) do
begin
j := j + 1;
l := Asc(Copy(dado, i, 1)) + Asc(Copy(ch, j, 1));
if (j = 50) then
j := 1;
if (l > 255) then
l := l - 256;
mensx := mensx + Chr(l)
end;
ECripta := mensx;
end;
function DCripta(Dado : String) : String;
var
mensx : String;
l, i, j : integer;
begin
j := 0;
mensx := '';
for i := 1 to length(Dado) do
begin
j := j + 1;
l := Asc(Copy(Dado, i, 1)) - Asc(Copy(ch, j, 1));
if (j = 50) then
j := 1;
if (l < 0) then
l := l + 256;
mensx := mensx + chr(l);
end;
DCripta := mensx;
end;
A função ECripta() devolve uma string criptografada e a DCripta() desfaz a criptografia.
Take care
Essa é uma rotina de criptografia simples. Pode ser útil a você, mas lembrando, é uma criptografia simples.
function ECripta(Dado : String) : String;
var
mensx : String;
l, i, j : integer;
begin
j := 0;
mensx := '';
for i := 1 to length(Dado) do
begin
j := j + 1;
l := Asc(Copy(dado, i, 1)) + Asc(Copy(ch, j, 1));
if (j = 50) then
j := 1;
if (l > 255) then
l := l - 256;
mensx := mensx + Chr(l)
end;
ECripta := mensx;
end;
function DCripta(Dado : String) : String;
var
mensx : String;
l, i, j : integer;
begin
j := 0;
mensx := '';
for i := 1 to length(Dado) do
begin
j := j + 1;
l := Asc(Copy(Dado, i, 1)) - Asc(Copy(ch, j, 1));
if (j = 50) then
j := 1;
if (l < 0) then
l := l + 256;
mensx := mensx + chr(l);
end;
DCripta := mensx;
end;
A função ECripta() devolve uma string criptografada e a DCripta() desfaz a criptografia.
Take care
Gerar senhas aleatórias
Salve, salve amigos,
Essa é uma dica simples e que para os que trabalham com redes sem fio pode ser muito útil. O que a função faz é gerar um string com caracteres hexadecimais, mas que podem ser adaptados para qualquer outro tipo
Esta função recebe como parâmetros o cumprimento da senha como um integer, e outros três parâmetros do tipo boolean que indicam se estarão presentes letras minúsculas, maiúsculas e números. Aqui vai o código e as explicações seguem logo abaixo.
function GeraSenhaHex(Digitos: Integer; Min: Boolean; Mai: Boolean; Num: Boolean): string;
const
MinC = 'abcdef';
MaiC = 'ABCDEF';
NumC = '1234567890';
var
p, q : Integer;
Char, Senha: String;
begin
Char := '';
If Min then Char := Char + MinC;
If Mai then Char := Char + MaiC;
If Num then Char := Char + NumC;
for p := 1 to Digitos do
begin
Randomize;
q := Random(Length(Char)) + 1;
Senha := Senha + Char[q];
end;
Result := Senha;
end;
Explicações:
Primeiro criamos as constantes que trarão os caracteres referentes a letras minúsculas, maiúsculas, e números, depois, iniciamos como vazia, só por desencargo de consciência já que o delphi faz isso por padrão, a variável "Char", que conterá todos os caracteres a serem usados para a geração da senha randômica.
Após isso, testamos os parâmetros para letras maiúsculas, minúsculas e números, acrescentando à "Char" cada um dos que forem verdadeiros segundo os parâmetros passados na chamada da função.
E depois, para finalizar, um laço com o número de repetições igual aos dígitos passados também como parâmetro na chamada, que usando a função Random do delphi gera números aleatórios dentro do limite estabelecido pelo cumprimento da variável "Char", lembrando que o fato de acrescentar o "+ 1" é por que as posições dos caracteres dentro de um string iniciam em 1, e a função Random gera números de 0 até o valor estipulado como limite. Por exemplo uma String = 'teste' temos os valores a seguir:
String[1] = 't'
String[2] = 'e'
String[3] = 's'
String[4] = 't'
String[5] = 'e'
Veja o exemplo de uso:
ShowMessage( GeraSenhaHex(8, False, True, True) );
//Senhas com 8 Caracteres e Letras Maiúsculas e Números
Take care
Essa é uma dica simples e que para os que trabalham com redes sem fio pode ser muito útil. O que a função faz é gerar um string com caracteres hexadecimais, mas que podem ser adaptados para qualquer outro tipo
Esta função recebe como parâmetros o cumprimento da senha como um integer, e outros três parâmetros do tipo boolean que indicam se estarão presentes letras minúsculas, maiúsculas e números. Aqui vai o código e as explicações seguem logo abaixo.
function GeraSenhaHex(Digitos: Integer; Min: Boolean; Mai: Boolean; Num: Boolean): string;
const
MinC = 'abcdef';
MaiC = 'ABCDEF';
NumC = '1234567890';
var
p, q : Integer;
Char, Senha: String;
begin
Char := '';
If Min then Char := Char + MinC;
If Mai then Char := Char + MaiC;
If Num then Char := Char + NumC;
for p := 1 to Digitos do
begin
Randomize;
q := Random(Length(Char)) + 1;
Senha := Senha + Char[q];
end;
Result := Senha;
end;
Explicações:
Primeiro criamos as constantes que trarão os caracteres referentes a letras minúsculas, maiúsculas, e números, depois, iniciamos como vazia, só por desencargo de consciência já que o delphi faz isso por padrão, a variável "Char", que conterá todos os caracteres a serem usados para a geração da senha randômica.
Após isso, testamos os parâmetros para letras maiúsculas, minúsculas e números, acrescentando à "Char" cada um dos que forem verdadeiros segundo os parâmetros passados na chamada da função.
E depois, para finalizar, um laço com o número de repetições igual aos dígitos passados também como parâmetro na chamada, que usando a função Random do delphi gera números aleatórios dentro do limite estabelecido pelo cumprimento da variável "Char", lembrando que o fato de acrescentar o "+ 1" é por que as posições dos caracteres dentro de um string iniciam em 1, e a função Random gera números de 0 até o valor estipulado como limite. Por exemplo uma String = 'teste' temos os valores a seguir:
String[1] = 't'
String[2] = 'e'
String[3] = 's'
String[4] = 't'
String[5] = 'e'
Veja o exemplo de uso:
ShowMessage( GeraSenhaHex(8, False, True, True) );
//Senhas com 8 Caracteres e Letras Maiúsculas e Números
Take care
Verificar se diretório esta vazio
Por Wesley Y
Nossa rotina precisa de um parâmetros para funcionar, o caminho do diretório que desejamos verificar se esta vazio ou não.
function TFrmPrincipal.ValidaDiretorio(Dir: string): Boolean;
var
SR: TSearchRec;
I: Integer;
begin
Result := False;
FindFirst(IncludeTrailingPathDelimiter(Dir) + '*', faAnyFile, SR);
for I := 1 to 2 do
if (SR.Name = '.') or (SR.Name = '..') then
Result := FindNext(SR) <> 0;
FindClose(SR);
end;
No onClick de um BitBtn
procedure TFrmPrincipal.BtnVerificar1Click(Sender: TObject);
begin
if DirectoryExists(EdtPasta.Text) then
begin
if ValidaDiretorio(EdtPasta.Text) then
TaskMessageDlg('Atenção', 'Diretório esta vazio', mtInformation, [mbOK], 0);
else
TaskMessageDlg('Atenção', 'Diretório não está vazio', mtInformation, [mbOK], 0);
end
else
TaskMessageDlg('Erro', 'Diretorio ' + EdtPasta.Text + ' não existe ', mtError , [mbOK], 0);
end;
Take care
Nossa rotina precisa de um parâmetros para funcionar, o caminho do diretório que desejamos verificar se esta vazio ou não.
function TFrmPrincipal.ValidaDiretorio(Dir: string): Boolean;
var
SR: TSearchRec;
I: Integer;
begin
Result := False;
FindFirst(IncludeTrailingPathDelimiter(Dir) + '*', faAnyFile, SR);
for I := 1 to 2 do
if (SR.Name = '.') or (SR.Name = '..') then
Result := FindNext(SR) <> 0;
FindClose(SR);
end;
No onClick de um BitBtn
procedure TFrmPrincipal.BtnVerificar1Click(Sender: TObject);
begin
if DirectoryExists(EdtPasta.Text) then
begin
if ValidaDiretorio(EdtPasta.Text) then
TaskMessageDlg('Atenção', 'Diretório esta vazio', mtInformation, [mbOK], 0);
else
TaskMessageDlg('Atenção', 'Diretório não está vazio', mtInformation, [mbOK], 0);
end
else
TaskMessageDlg('Erro', 'Diretorio ' + EdtPasta.Text + ' não existe ', mtError , [mbOK], 0);
end;
Take care
Imprimir qualquer arquivo direto do Delphi
Por Wesley Y
Vamos mostrar como imprimir qualquer tipo de arquivo direto pelo Delphi, seja um Doc, txt, XLS, ou qualquer formato.
Vamos ao exemplo
Adicione
1 OpenDialog
2 Button (BtnImprimir e BtnAbrir)
1 Edit ( EdtCaminho)
Obs : Precisamos dar uses em ShellAPI.
No onClick do BtnAbrir
procedure TFrmPrincipal.BtnAbrirClick(Sender: TObject);
begin
if OpenDialog1.Execute then
EdtCaminho.Text := OpenDialog1.FileName;
end;
No onClick do BtnImprimir – Enviamos um comando através do Delphi enviando o arquivo direto pra impressora padrão do Windows.
procedure TFrmPrincipal.BtnImprimirClick(Sender: TObject);
begin
ShellExecute(Handle, 'print',
PChar(OpenDialog1.FileName ),
nil, nil, SW_HIDE) ;
end;
end.
Take care
Vamos mostrar como imprimir qualquer tipo de arquivo direto pelo Delphi, seja um Doc, txt, XLS, ou qualquer formato.
Vamos ao exemplo
Adicione
1 OpenDialog
2 Button (BtnImprimir e BtnAbrir)
1 Edit ( EdtCaminho)
Obs : Precisamos dar uses em ShellAPI.
No onClick do BtnAbrir
procedure TFrmPrincipal.BtnAbrirClick(Sender: TObject);
begin
if OpenDialog1.Execute then
EdtCaminho.Text := OpenDialog1.FileName;
end;
No onClick do BtnImprimir – Enviamos um comando através do Delphi enviando o arquivo direto pra impressora padrão do Windows.
procedure TFrmPrincipal.BtnImprimirClick(Sender: TObject);
begin
ShellExecute(Handle, 'print',
PChar(OpenDialog1.FileName ),
nil, nil, SW_HIDE) ;
end;
end.
Take care
DLL para validar CPF e CNPJ - Parte II
-- Por Wesley Y
DLL para validar CPF e CNPJ - Parte II
Bom pessoal neste artigo será mostrado como consumir a DLL de validação de CNPJ e CPF que foi desenvolvida na Parte I.
Vamos criar uma Aplicação. Adicionar:
2 Edits ( edtCPF, EdtCNPJ)
1 Button – BtnValidar
Vamos fazer algumas inclusões em nossa Unit.
Unit uFrmPrincipal;
Interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
DLLData = 'prj_DLL_CNPJ_CPF.dll';
// Coloque a DLL junto com o Executável, ou então fixe o caminho da
// mesma , C:\DLL\_DLL_CNPJ_CPF.dll'
type
TForm2 = class(TForm)
Edit1: TEdit;
BtnValidar: TButton;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure BtnValidarClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
{Funções da DLL }
Function TestaCpfCgc(Value: String): String; stdcall; external DLLData;
// Declaração Identica como fazemos na criação da DLL,
// e dizemos que vamos usar a DLLData
implementation
{$R *.dfm}
{Clique do BtnValidar}
procedure TForm2.BtnValidarClick(Sender: TObject);
begin
TestaCpfCgc(Edit1.Text);
TestaCpfCgc(Edit2.Text)
end;
end.
Conclusão
Temos agora de forma encapsulada, funções muito usadas para validação de CPF e CNPJ, obviamente que as funçoes/algoritimos foram retirados da internet e apenas foram transcritas para a DLL, tornando assim acessível para qualquer aplicação, seja em Delphi ou não.
Take care
DLL para validar CPF e CNPJ - Parte II
Bom pessoal neste artigo será mostrado como consumir a DLL de validação de CNPJ e CPF que foi desenvolvida na Parte I.
Vamos criar uma Aplicação. Adicionar:
2 Edits ( edtCPF, EdtCNPJ)
1 Button – BtnValidar
Vamos fazer algumas inclusões em nossa Unit.
Unit uFrmPrincipal;
Interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
DLLData = 'prj_DLL_CNPJ_CPF.dll';
// Coloque a DLL junto com o Executável, ou então fixe o caminho da
// mesma , C:\DLL\_DLL_CNPJ_CPF.dll'
type
TForm2 = class(TForm)
Edit1: TEdit;
BtnValidar: TButton;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure BtnValidarClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
{Funções da DLL }
Function TestaCpfCgc(Value: String): String; stdcall; external DLLData;
// Declaração Identica como fazemos na criação da DLL,
// e dizemos que vamos usar a DLLData
implementation
{$R *.dfm}
{Clique do BtnValidar}
procedure TForm2.BtnValidarClick(Sender: TObject);
begin
TestaCpfCgc(Edit1.Text);
TestaCpfCgc(Edit2.Text)
end;
end.
Conclusão
Temos agora de forma encapsulada, funções muito usadas para validação de CPF e CNPJ, obviamente que as funçoes/algoritimos foram retirados da internet e apenas foram transcritas para a DLL, tornando assim acessível para qualquer aplicação, seja em Delphi ou não.
Take care
DLL para validar CPF e CNPJ - Parte I
-- Por Wesley Y
DLL para validar CPF e CNPJ - Parte I
Vamos criar uma DLL para validar CPF e CNPJ, então vamos criar a DLL.
Para maiores informações sobre DLL veja os links abaixo..
http://www.devmedia.com.br/articles/viewcomp.asp?comp=15450
http://www.devmedia.com.br/articles/viewcomp.asp?comp=15451
http://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 na 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
Proximo post veremos como consumir esta DLL.
Take care.
DLL para validar CPF e CNPJ - Parte I
Vamos criar uma DLL para validar CPF e CNPJ, então vamos criar a DLL.
Para maiores informações sobre DLL veja os links abaixo..
http://www.devmedia.com.br/articles/viewcomp.asp?comp=15450
http://www.devmedia.com.br/articles/viewcomp.asp?comp=15451
http://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 na 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
Proximo post veremos como consumir esta DLL.
Take care.
Assinar:
Postagens (Atom)