um colega postou a um tempo atras... function ValidaEmail(email: string): boolean; // Retorna True se o endereço de e-mail for válido const // Caracteres válidos em um "atom" atom_chars = [#33..#255] - ['(', ')', '<', '>', HYPERLINK "mailto:'@'"'@', ',', ';', ':', '\', '/', '"', '.', '[', ']', #127]; // Caracteres válidos em um "quoted-string" quoted_string_chars = [#0..#255] - ['"', #13, '\']; // Caracteres válidos em um "sub-domain" 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, subdomains: integer; c: char; begin State := STATE_BEGIN; n := Length(email); i := 1; subdomains := 1; while (i <= n) do begin c := email[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 = HYPERLINK "mailto:'@'"'@' 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 = HYPERLINK "mailto:'@'"'@' 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(subdomains); 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 (subdomains >= 2); end;
-- No virus found in this outgoing message. Checked by AVG Anti-Virus. Version: 7.0.308 / Virus Database: 267.10.10 - Release Date: 15/8/2005 [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] ou [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: http://br.yahoo.com/info/utos.html