mensagem = 'O endereço de e-mail que você digitou não é um endereço
válido para a internet.' + #13#10 +
'Deseja adicionar o endereço mesmo assim ?';
var
vet_valido: array [0..35] of string =
('0','1','2','3','4','5','6','7','8','9',
'a','b','c','d','e','f',
'g','h','i','j',
'k','l','m','n','o','p','q','r','s','t',
'u','v', 'w','x','y','z');
function VerificaEmail(email: string): boolean;
var
i, j, tam_email, simb_arroba, simb_arroba2, qtd_arroba, qtd_pontos,
qtd_pontos_esq, qtd_pontos_dir, posicao, posicao2, ponto, ponto2 :
integer;
vet_email : array [0..49] of string; //50 posições, capacidade do Edit
msg : string;
begin
qtd_pontos := 0;
qtd_pontos_esq := 0;
qtd_pontos_dir := 0;
qtd_arroba := 0;
posicao := 0;
posicao2 := 0;
simb_arroba := 0;
simb_arroba2 := 0;
ponto := 0;
ponto2 := 0;
msg := '';
Result := True;
//Verificando parte inicial do E-mail
tam_email := Length(email);
for i := 0 to tam_email - 1 do
begin
vet_email[i] := Copy(email, i + 1, 1);
if vet_email[i] = '@' then
begin
Inc(qtd_arroba);
posicao := i;
end;
end;
if ((vet_email[0] = '@') or (vet_email[0] = '.') or (vet_email[0] = '-'))
then
begin
Result := False;
msg := mensagem;
end;
//Verificando se tem o símbolo @ e quantos tem
if qtd_arroba < 1 then
begin
Result := False;
msg := mensagem;
end
else
if qtd_arroba > 1 then
begin
Result := False;
msg := mensagem;
end
else
//Verificando o que vem antes e depois do símbolo @
begin
for i := 0 to 35 do
begin
if vet_email[posicao - 1] <> vet_valido[i] then
Inc(simb_arroba)
else
Dec(simb_arroba);
if vet_email[posicao + 1] <> vet_valido[i] then
Inc(simb_arroba2)
else
Dec(simb_arroba2);
end;
if simb_arroba = 36 then
begin
//Antes do arroba há um símbolo desconhecido do vetor válido
Result := False;
msg := mensagem;
end
else
if simb_arroba2 = 36 then
begin
//Depois do arroba há um símbolo desconhecido do vetor válido
Result := False;
msg := mensagem;
end
end;
//Verificando se há pontos e quantos, e Verificando parte final do e-mail
for j := 0 to tam_email - 1 do
if vet_email[j] = '-' then
if ((vet_email[j - 1] = '.') or (vet_email[j - 1] = '-')) then
begin
Result := False;
msg := mensagem;
end;
for i := 0 to tam_email - 1 do
if vet_email[i] = '.' then
begin
Inc(qtd_pontos);
posicao2 := i + 1;
if i > posicao then
Inc(qtd_pontos_dir)
else
Inc(qtd_pontos_esq);
if ((vet_email[i - 1] = '.') or (vet_email[i - 1] = '-')) then
begin
Result := False;
msg := mensagem;
end;
end;
if qtd_pontos < 1 then
begin
Result := False;
msg := mensagem;
end
else if vet_email[tam_email - 1] = '.' then
begin
Result := False;
msg := mensagem;
end
else
if vet_email[tam_email - 2] = '.' then
begin
Result := False;
msg := mensagem;
end
else if qtd_pontos_dir > 2 then
begin
Result := False;
msg := mensagem;
end
else
if (not ((((tam_email - posicao2) = 3) and (qtd_pontos_dir = 1)) or
(((tam_email - posicao2) = 2) and (qtd_pontos_dir = 2)) or
(((tam_email - posicao2) = 2) and (qtd_pontos_dir = 1)))) then
begin
Result := False;
msg := mensagem;
end
else
//Verificando o que vem antes e depois do ponto
begin
for i := 0 to 35 do
begin
if vet_email[posicao2 - 2] <> vet_valido[i] then
Inc(ponto)
else
Dec(ponto);
if vet_email[posicao2] <> vet_valido[i] then
Inc(ponto2)
else
Dec(ponto2);
end;
if ponto = 36 then
begin
//Antes do ponto há um símbolo desconhecido do vetor válido
Result := False;
msg := mensagem;
end
else
if ponto2 = 36 then
begin
//Depois do ponto há um símbolo desconhecido do vetor válido
Result := False;
msg := mensagem;
end
end;
//Verificação final
if not Result then
msg := mensagem;
end;
-----Mensagem original-----
De: delphi-br@yahoogrupos.com.br [mailto:[EMAIL PROTECTED]
nome de Fernando Derkoski
Enviada em: quarta-feira, 19 de abril de 2006 09:46
Para: Delphi Br
Assunto: [delphi-br] Validar Email
como faço para validar um campo onde vai o email, tipo assim tem que ter
uma palavra, um @ e depois do arroba tem q ter uma palavra e um . (ponto) e
uma outra palavra e não pode ter caracteres especiais.
obrigado pela ajuda
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Yahoo! Grupos, um serviço oferecido por:
PUBLICIDAD
----------------------------------------------------------------------------
--
Links do Yahoo! Grupos
a.. Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
b.. Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
c.. O uso que você faz do Yahoo! Grupos está sujeito aos Termos do
Serviço do Yahoo!.
__________ Informação do NOD32 1.1454 (20060321) __________
Esta mensagem foi verificada pelo NOD32 Sistema Antivírus
http://www.nod32.com.br
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
- Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
- Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
- O uso que você faz do Yahoo! Grupos está sujeito aos Termos do Serviço do Yahoo!.
