Clique para saber mais...
  Home     Download     Produtos / Cursos     Revista     Vídeo Aulas     Fórum     Contato   Clique aqui para logar | 07 de Junho de 2026
  Login

Codinome
Senha
Salvar informações

 Esqueci minha senha
 Novo Cadastro

  Usuários
26 Usuários Online

  Revista ActiveDelphi
 Assine Já!
 Edições
 Sobre a Revista

  Conteúdo
 Apostilas
 Artigos
 Componentes
 Dicas
 News
 Programas / Exemplos
 Vídeo Aulas

  Serviços
 Active News
 Fórum
 Produtos / Cursos

  Outros
 Colunistas
 Contato
 Top 10

  Publicidade

  [Dicas]  Validando endereços de e-mail
Publicado por admin : Quarta, Fevereiro 23, 2011 - 11:00 GMT-3 (1659 leituras)
Comentários 4 Comentários   Enviar esta notícia a um amigo Enviar para um amigo   Versão para Impressão Versão para impressão
Administrador Veja nesta dica uma função que apresenta como validar um endereço de e-mail, evitando que sejam informados dados incorretos nos cadastros.

Segue a implementação:

function ValidaEmail(sEmail: string): boolean;
const
  // Caracteres válidos
  ATOM_CHARS = [#33..#255] - ['(', ')', '<', '>', \@\, ',', ';', ':',
                              '\', '/', '"', '.', '[', ']', #127];
 
  // Caracteres válidos em uma cadeia
  QUOTED_STRING_CHARS = [#0..#255] - ['"', #13, '\'];
 
  // Caracteres válidos em um subdominio
  LETTERS = ['A'..'Z', 'a'..'z'];
  LETTERS_DIGITS = ['0'..'9', 'A'..'Z', 'a'..'z'];
  SUBDOMAIN_CHARS = ['-', '0'..'9', 'A'..'Z', 'a'..'z'];
 
type
  States = (STATE_BEGIN, STATE_ATOM, STATE_QTEXT, STATE_QCHAR,
    STATE_QUOTE, STATE_LOCAL_PERIOD, STATE_EXPECTING_SUBDOMAIN,
    STATE_SUBDOMAIN, STATE_HYPHEN);
var
  State: States;
  i, n, iSubdomains: integer;
  c: char;
begin
  State := STATE_BEGIN;
  n := Length(sEmail);
  i := 1;
  iSubdomains := 1;
  while (i <= n) do
  begin
    c := sEmail[i];
    case State of
      STATE_BEGIN:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_ATOM:
        if c = \@\ then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else if not (c in atom_chars) then
          break;
      STATE_QTEXT:
        if c = '\' then
          State := STATE_QCHAR
        else if c = '"' then
          State := STATE_QUOTE
        else if not (c in quoted_string_chars) then
          break;
      STATE_QCHAR:
        State := STATE_QTEXT;
      STATE_QUOTE:
        if c = \@\ then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else
          break;
      STATE_LOCAL_PERIOD:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_EXPECTING_SUBDOMAIN:
        if c in letters then
          State := STATE_SUBDOMAIN
        else
          break;
      STATE_SUBDOMAIN:
        if c = '.' then
        begin
          Inc(iSubdomains);
          State := STATE_EXPECTING_SUBDOMAIN
        end
        else if c = '-' then
          State := STATE_HYPHEN
        else if not (c in letters_digits) then
          break;
      STATE_HYPHEN:
        if c in letters_digits then
          State := STATE_SUBDOMAIN
        else if c <> '-' then
          break;
    end;
    Inc(i);
  end;
 
  if i <= n then
    Result := False
  else
    Result := (State = STATE_SUBDOMAIN) and (iSubdomains >= 2);
 
  //se sEmail esta vazio retorna true
  if sEmail = '' then
    Result := true;
end;

Para testar, adicione a um novo formulário um Edit e um Button, programando no evento onClick deste último:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if ValidaEmail(Edit1.Text) then
    ShowMessage('Ok! E-mail válido!')
  else
    ShowMessage('E-mail inválido!');
end;

Agora rode o programa e faça os testes digitando vários endereços de e-mail do Edit1 e clicando sobre o botão.

Espero que seja útil.
Por: Alexandre
Contato: mmalexhot@hotmail.com



Comentários Comentários
   Ordem:  
Comentários pertencem aos seus respectivos autores. Não somos responsáveis pelo seus conteúdos.


por: BrunoMoreyra (brunomoreyra@yahoo.com.br) : Fev 23, 2011 - 02:28
(Informações sobre o membro | Enviar uma mensagem) http://
Boa tarde,

realizei alguns testes e funcionou.
Mas acho que contém uma funcionalidade mais simples.


function EmailOk(Email: String): Boolean;
var PosArroba, PosPonto, PosEspaco :Integer;
begin
PosEspaco:= Pos(' ', Email);

PosArroba:= Pos(\@\, Email);

Delete(Email, 1, PosArroba);
PosPonto:= Pos('.', Email);

//Se não existe espaço, existe arroba, existe pelo menos um ponto depois do arroba e algum
//outro caracter após este ponto então considera o e-mail válido
Result:= (PosEspaco = 0) and (PosArroba > 0) and (PosPonto > 0) and (Email[PosPonto+1]<>'');
end;



por: hud.active (hudson@activemaster.com.br) : Set 09, 2011 - 10:10
(Informações sobre o membro | Enviar uma mensagem)
Esta função é complexa mas bem útil. Minha empresa tem um programa pra sindicato que cadastra os emails das empresas, porém os usuários geralmente erram a digitação e colocam coisas sem nexo, como financeiro@empresa ai esquece do ponto, quando não esquece do arroba também.
Hudson
www.activemaster.com.br
  Edição 112

Revista ActiveDelphi

  50 Programas Fontes


  Produtos

Conheça Nossos Produtos

Copyright© 2001-2016 – Active Delphi – Todos os direitos reservados