Fonction qui renvoi un morceau de texte a partir d'un texte et délimité par certains caractères

Télécharger le projet
Commenter

Description

Cette fonction est assez spéciale, je l'est faire car elle me sert dans un de mes programme, peut-être elle vous servira a vous aussi :)
Pour l'illustrer, voici un exemple
Vous avez un texte de ce style:
'machin@bidule.com;truk@cool.fr;chose@free.fr'
en gros cette fonction va vous permettre en quelques lignes de code d'extraire les email présent dans ce texte

Voici les paramètres de la fonction:
Source -> le texte source
TexteDep -> le texte a chercher
Limites -> chaine contenant tous les caractères qui peuvent limiter le morceau a cherche
Depart -> le caractère de départ
Deb -> mettre une variable : le départ du morceau y sera retourné
Longueur -> mettre une variable : la longueur du morceau y sera retourné

Source / Exemple : 


function ExtraireTexte(Source:string;TexteDep:string;Limites:string;Depart:integer;var Deb:integer; Var Longueur:integer):string;
var
a,b:integer;
Fin:integer;
TmpS:string;
BVal:boolean;
begin
Result:='';
if Source='' then exit; //faut ki est kelke chose sinon ca va pas ;)

//cherche TexteDep dans Source
a:=Depart;
BVal:=true;
while BVal do begin
  //dès k'il trouve
  if copy(Source,a,Length(TexteDep))=TexteDep then begin
    BVal:=false;//arrête le boucle
    Depart:=a;//change le dépat
  end;
  //si c a la fin, ben alors il a rien trouvé, terminé
  if (a>=Length(Source)) and (BVal=true) then begin
    BVal:=false;
    exit;
  end;
  inc(a,1);//incrémente
end;

//Cherche le début (Deb)
a:=Depart;
BVal := true;
while BVal=true do begin
  //cherche un caractère limite
  TmpS := copy(Source,a,1);
  for b:=1 to Length(Limites) do begin
    if copy(Limites,b,1)=TmpS then begin
      BVal:=false;//y'en a un, on a trouvé le début
      a:=a+2;
    end;
  end;
  dec(a,1);
  if a<1 then begin
    BVal:=false;//on est au bout :)
    a:=a+1;
  end;
end;
Deb:=a;

//Cherche la fin (Fin)
a:=Depart;
BVal:=true;
while BVal=true do begin
  //cherche un caractère limite
  TmpS := copy(Source,a,1);
  for b:=1 to Length(Limites) do begin
    if copy(Limites,b,1)=TmpS then begin
      BVal:=false;//y'en a un, on a trouvé le début
      a:=a-1;
    end;
  end;
Inc(a,1);
  if TmpS='' then begin
    BVal:=false;//on est au bout :)
    a:=a-1;
  end;
end;
Fin:=a;

Longueur := Fin-Deb;
//prend le morceu
Result := copy(Source,Deb,Fin-Deb);

end;

Conclusion :


L'exemple fonctionnera alors kom ceci:
mettre un Memo et un ListBox:

var
Deb,Longueur:integer;
TmpS:string;
begin
Memo1.Text := 'machin@bidule.com;truk@cool.fr;chose@free.fr';
ListBox1.Clear;
TmpS := ExtraireTexte(Memo1.Text,'@',';',1,Deb,Longueur);
while TmpS<>'' do begin
listBox1.Items.Add(TmpS);
TmpS := ExtraireTexte(Memo1.Text,'@',';',Deb+Longueur,Deb,Longueur);
end;

Pour voir l'exemple en démonstration, cf zip
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (fabiin)