Delphi - E-mail címek kigyűjtése tetszőleges szövegből

Az eljárás deklarációja a következőképpen néz ki:

procedure GettingEmails(text:string; var list:TStringList;
      filter:TStrings);

A text paraméterben kell megadni azt a szöveget, amiben az email címeket keressük. A list paraméter egy TStringList osztály, amibe a megtalált email címeket fogjuk tárolni. A filter paraméterben adhatjuk meg azokat a domain neveket, amelyekhez tartozó email címeket nem szeretnénk a listánkra felvenni. Ha nem akarunk szűrőt alkalmazni, akkor egyszerűen adjunk meg NIL-t.

procedure GettingEmails;
var
  GoodChars:set of char;
  p, c:integer;
  LeftPart, RightPart, Email:string;
  filters:TStringList;

A GoodChars halmazban adjuk meg az email címekben használható karaktereket. Ezek a kis- és nagybetűk, valamint a pont. A LeftPart és RightPart változókban az email cím bal- és jobboldalát fogjuk tárolni. Az Email változó az "összerakott" email címet tartalmazza. A filters osztályban tároljuk a domain szűrő listát, amit a filter paraméterben kapunk meg.
Az eljárás elején megadjuk az elfogadható karaktereket, töröljük a listánkat és beállítjuk a domain szűrő listát.

begin
  GoodChars:=['a'..'z', 'A'..'Z', '0'..'9', '.', '-', '_'];
  list.Clear;
  filters:=TStringList.Create;
  if Assigned(filter) then Filters.AddStrings(filter);

Első lépésben megkeressük az első "@" karaktert a szövegben (text), és a pozícióját a p változóban tároljuk. Ha nincs ilyen karakter, akkor a p értéke 0.

  p:=Pos('@', text);

Egy ciklust indítunk, amíg a p változó értéke nagyobb, mint 0, vagyis találtunk még @ karaktert.

  while p>0 do
  begin

Először az email cím bal oldalát keressük meg. Ehhez a pozíciótól egyesével el kell indulnunk balra. Az aktuális karakter pozícióját a c változóban fogjuk tárolni. A c változó értéke kezdetben p-1. Addig olvassuk ki a karaktereket, amíg azok az elfogadott karakterekhez tartoznak, miközben a c-t mindig csökkentjük 1-gyel és a kiolvasott karaktert hozzáadjuk a LeftPart elejéhez (fontos, hogy az elejéhez adjuk, különben a betűk fordított sorrendben lesznek).

    leftpart:='';
    if p>1 then begin
      c:=p-1;
      while (text[c] in GoodChars) and (c>0) do begin
        leftpart:=text[c]+leftpart;
        dec(c);
      end;
    end;

Ha megvan a baloldal, akkor jöhet a jobboldal. Ezt hasonlóan kapjuk meg, mint a baloldalt, de itt a p+1 pozícióról indulunk, és a pozíciót folyamatosan 1-gyel növeljük, miközben a karaktereket olvassuk. Itt viszont fordítva kell eljárnunk, mint az előző esetben, mert itt a RightPart végéhez kell adni a kiolvasott karaktert a helyes betűsorrend eléréséhez.

    rightpart:='';
    if p<length(text) then
    begin
      c:=p+1;
      while (text[c] in GoodChars) and 
            (c<=length(text)) do begin
        rightpart:=rightpart+text[c];
        inc(c);
      end;
    end;

A szövegben lehetnek olyan @ karakterek, amik nem email címhez tartoznak. Ilyenkor szinte biztos, hogy a baloldali és/vagy a jobboldali rész egy üres sztring. Tehát mielőtt hozzáadnánk a listához ellenőriznünk kell, hogy mindkét rész tartalmaz karaktereket. Ha minden rendben, akkor az Email változóba "összerakjuk" az email címet, majd ellenőrizzük, hogy rajta van-e a listánkon, ill. a jobboldali rész (rightpart) benne van-e a szűrő listában. Ha egyik feltétel sem igaz, akkor hozzáadjuk a listánkhoz.

    if (leftpart<>'') and (rightpart<>'') then begin
      Email:=leftpart+'@'+rightpart;
      if (list.IndexOf(Email)<0) and (filters.IndexOf(
             rightpart)<0) then list.Append(Email);
    end;

A szövegből törölni kell a megtalált @ karaktert, hiszen ha ezt nem tesszük meg, akkor ugyanazt az email címet fogjuk gyűjtögetni végestelen-végig.

    Delete(text, p, 1);

Ha töröltük a @ karaktert, akkor megkeressük a következőt. Ezt addig folytatjuk, amíg a p értéke nagyobb, mint 0, vagyis amíg található ilyen karakter.

    p:=Pos('@', text);
  end;

Ez pedig már az eljárás vége.

  filters.Free;
end;