EEEEEssse Google É O CARA!
[]s Walter Alves Chagas Junior Projeto e desenvolvimento Telemont Engenharia de telecomunicações Belo Horizonte - MG - Brazil [EMAIL PROTECTED] Fone: (31) 3389-8215 Fax: (31) 3389-8200 -----Mensagem original----- De: delphi-br@yahoogrupos.com.br [mailto:[EMAIL PROTECTED] nome de Romario (Listas) Enviada em: segunda-feira, 24 de outubro de 2005 13:06 Para: delphi-br@yahoogrupos.com.br Assunto: Re: [delphi-br] Formato E-Mail ============================================================== Eu perguntei ao nosso amigo GOOGLE e veja o que ele respondeu: ============================================================== Validando formato de e-mail: Primeiramente vc deverá ter num form: Um Edit (ou DBEdit), um Button e um Label. Antes de implementation coloque: Const msg1 = 'Caractere(s) inválido(s) no início do e-mail.'; msg2 = 'Símbolo @ não foi encontrado.'; msg3 = 'Excesso do símbolo @.'; msg4 = 'Caractere(s) inválido(s) antes do símbolo @.'; msg5 = 'Caractere(s) inválido(s) depois do símbolo @.'; msg6 = 'Agrupamento de caractere(s) inválido(s) a esqueda do @.'; msg7 = 'Não existe ponto(s) digitado(s).'; msg8 = 'Ponto encontrado no final do e-mail.'; msg9 = 'Ausência de caractere(s) após o último ponto.'; msg10 = 'Excesso de ponto(s) a direita do @.'; msg11 = 'Ponto(s) disposto(s) de forma errada após o @.'; msg12 = 'Caractere(s) inválido(s) antes do ponto.'; msg13 = 'Caractere(s) inválido(s) depois do ponto.'; var Form1: TForm1; { <--- Nome do meu formulário } 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'); Depois de implementation {$R *.DFM} coloque a seguinte função: function func_VerifEmail(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 Nesta função (func_VerifEmail) é utilizada a função Copy, exemplo: Copy(s,i,t) significa trecho de s que começa em i com tamanho t} 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:= msg1; end; //Verificando se tem o símbolo @ e quantos tem if qtd_arroba < 1 then begin Result:= False; msg:= msg2; end else if qtd_arroba > 1 then begin Result:= False; msg:= msg3 + ' Encontrado(s): '+IntToStr(qtd_arroba)+'.'; 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:= msg4; end else if simb_arroba2 = 36 then begin //Depois do arroba há um símbolo desconhecido do vetor válido Result:= False; msg:= msg5; 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:= msg6; 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:= msg6; end; end; if qtd_pontos < 1 then begin Result:= False; msg:= msg7; end else if vet_email[tam_email-1] = '.' then begin Result:= False; msg:= msg8; end else if vet_email[tam_email-2] = '.' then begin Result:= False; msg:= msg9; end else if qtd_pontos_dir > 2 then begin Result:= False; msg:= msg10 + ' Encontrado(s): '+ IntToStr(qtd_pontos)+#10+'Encontrado(s) a direita do @: '+ IntToStr(qtd_pontos_dir)+'.'; 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:= msg11 +#10+ 'Encontrado(s) a esquerda do @: '+ IntToStr(qtd_pontos_esq) +#10+ 'Encontrado(s) a direita do @: '+ IntToStr(qtd_pontos_dir)+'.'; 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:= msg12; end else if ponto2 = 36 then begin //Depois do ponto há um símbolo desconhecido do vetor válido Result:= False; msg:= msg13; end end; //Verificação final if not Result then begin msg:= msg +#10+ 'Formato de E-mail não aceitável!!'; MessageDlg(msg,mtWarning,[mbRetry],0); end; end; {Os componentes devem ser configurados assim: O Form possui keypreview=true e evento onkeypress, o Edit possui evento onchange e o Button possui evento onclick. As procedures seguem abaixo} procedure TForm1.Button1Click(Sender: TObject); begin Label1.Caption:= ''; if Trim(Edit1.Text)<>'' then if (func_VerifEmail(Trim(Edit1.Text))) then begin Label1.Caption:= Trim(Edit1.Text)+' está OK.'+#10+'Formato aceitável.'; Button1.Enabled:= False; end else begin Button1.SetFocus; Edit1.SetFocus; Edit1.SelText; end end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then Button1Click(Sender); if (not ((Key in ['0'..'9']) or (Key in ['A'..'Z']) or (Key in ['a'..'z']) or (Key = '@') or (Key = '.') or (Key = '-'))) then Key:= #0; end; procedure TForm1.Edit1Change(Sender: TObject); begin Label1.Caption:= ''; Button1.Enabled:= True; end; //Ligue os eventos corretamente e verifique o resultado Sds, Romario HNS Informática escreveu: > Olá! > > Alguém tem uma rotina para verificar se um e-mail é ou não é válido??? > > Abraços > > Charles A. Chiodi _______________________________________________________ Promoção Yahoo! Acesso Grátis: a cada hora navegada você acumula cupons e concorre a mais de 500 prêmios! Participe! http://yahoo.fbiz.com.br/ -- <<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>> Links do Yahoo! Grupos [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: http://br.yahoo.com/info/utos.html
