Detection d'email incorrect

Version imprimable

Bonjour,

Voici un bout de code qui permet de detecter les emails dans un texte.
Je ne sais pas pourquoi il ne fonctionne pas car il retourne une valeur trop longue exemple : "dupont@hotmail.com textentrop".

Si vous pouviez m'aider. De plus j'ai une fonction while qui detecte la fin et le debut de l'adresse email part un caractère spéciaux. Si vous avez mieux à me proposé je suis preneur car elle me semble pas très optimisé !

Merci d'avance

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure DetecteEmail(data: string);
var
  Index,i,j : integer;
  Texte,tmp: string;
begin
   Texte:=data;
 
   Index:= pos('@',Texte);
    While Index <> 0 do
    Begin
      i:=Index;
      While (Texte[i] <> ';')and(Texte[i] <> '"')and(Texte[i] <> '''')and(Texte[i] <> '>')and(Texte[i] <> '&')and(Texte[i] <> ' ')and(Texte[i] <> '!')and(Texte[i] <> '%')and(i < length(Texte)) do
       inc(i);
       if i-Index < 20 then
       begin
         j:=Index;
         While (Texte[j] <> ';')and(Texte[j] <> '"')and(Texte[j] <> '''')and(Texte[j] <> '>')and(Texte[j] <> '&')and(Texte[j] <> ' ')and(Texte[j] <> '!')and(j <> 1) do
         j:=j-1;
         if Index-j < 20 then
         begin
         tmp:=Copy(Texte,j,i);
           AjouterEmail(tmp);
           Delete(Texte,1, i);
         end;
       end;
       Index:= pos('@',Texte);
    end;
end;

20/09/2005, 23h15
e-ric
C'est l'instruction
Code:

1 2 tmp:=Copy(Texte,j,i);
qui pose problème, le paramètre i correspond dans ton appel à une position alors que Pos attend une longueur pour ce paramètre.

En lieu et place, il te faut donc écrire :
Code:

1 2 tmp:=Copy(Texte,j,i-j+1);
Cela devrait corriger ton problème.

cdlt

e-ric
21/09/2005, 00h08
laclac

C'était ca !

Merci bcp e-ric!! :wink:

on cherchant sur le forum un moyen de vérifier la syntaxe d'un email je suit tombé sur ce post alors j'ai pu corigé un peut les manque de votre procédure.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Function EmailValid(Email: string):Boolean;
 Const
   Mauvais_Character : set of char= ([';','"','*','%','<','>','''','&',' ','!','?','/'] );
 Var
  Arobas_Index,Dot_Index,I: integer;
  Compte,Serveur: string;
begin
 
   Result := True;
   Arobas_Index:= pos('@',Email);
  if Arobas_Index=0 then begin Result := False; end
    else
   begin
       Compte := Copy(Email,1,Arobas_Index-1);
       Serveur := Copy(Email,Arobas_Index+1,length(Email)-Arobas_Index+1);
       Dot_Index :=pos('.',Serveur);  // vérification de l'existance du . dans la second partie de l'adresse
     if  Dot_Index = 0 then begin Result := False; Exit;end
      else
       if length(Copy(Serveur,Dot_Index,length(Serveur)-Dot_Index+1)) <= 3 Then begin Result := False; Exit;end // .com
       else
       begin
         For  I:=1 to length(Compte) do
         if (Compte[I] in Mauvais_Character) Then begin Result := False;Break;end;     //vérification de l'existance de characthères non autoriser
         if Result = False Then Exit;
 
         For I:=1 to length(Serveur) do
         if (Serveur[I] in Mauvais_Character) Then begin Result := False;Break; end;
         if Result = False Then Exit;
       end ;
   end;
end;