Extract emails from a Memo

1

I have a memo component, inside it there is a large text, and in this text it contains several scattered e-mail addresses.

How can I just extract emails from this memo1 and play on memo2 ?

    
asked by anonymous 21.08.2015 / 16:01

2 answers

0

The following routine would work in Python, you could try converting to use the Delphi regular expression class. Remembering that there is no regular expression that takes 100% of valid emails, but good expressions take 99.9%.

import re
import sys

email_regex = "[\w\.\+\-]+\@[\w]+\.[a-z]{2,3}"
regex = re.compile(email_regex)

data = open(sys.argv[1]).read()

for email in regex.finditer(data):
    print data[email.start(0):email.end(0)]
    
26.08.2015 / 22:52
0

From the example you left in the comment, it is understood that the emails are separated by spaces between the text, just look for the line by the blank spaces for each word that we pass to a variable and check if the word can correspond to an email, if yes then we keep, and we go to the next word.

To test, you need to create a new project, add to the project 1 button, 2 memos and copy the code:

procedure TForm1.FormCreate(Sender: TObject);
begin
  //escreve texto no memo
  Memo1.Text := '[email protected] 32l32k323l23232@2222222  2.2.22 [email protected] 3434534 dsf s32234324 [email protected]  adas asdfaaaaaaaaaaaa [email protected]';
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, APos: Integer;
    ALine, AWord, ALetter, AEmail: String;
    FoundAT, FoundDOT: boolean;
begin
  //vai correr as linhas todas do memo
  for i := 0 to Memo1.Lines.Count - 1 do
    Begin
      ALine := Memo1.Lines[i];

      //enquanto a linha tiver texto verifica
      While ALine <> '' do
        Begin
          FoundAT := False;
          FoundDOT := False;
          AEmail := '';

          //procuro espaços o próximo espaço " " 
          APos := Pos(' ', ALine);
          if (APos > 0) then
            begin
              //pego a palavra e apago-a da variável ALine
              AWord := Trim(AnsiMidStr(ALine, 1, APos - 1));
              Delete(ALine, 1, APos);
            end
          else
            Begin
              //quando não encontramos mais " " então pegamos o resto da linha  
              AWord := ALine;
              ALine := '';
            End;

          AEmail := AWord;

          //vamos analisar letra a letra 
          while AWord <> '' do
            Begin
              ALetter := Trim(AnsiMidStr(AWord, 1, 2 - 1));
              Delete(AWord, 1, 1);

              //procuramos pelo arroba e pelo ponto 
              if (ALetter = '@') then FoundAT := True
              else if (ALetter = '.') then FoundDOT := True;

              //se encontrou arroba e ponto então erscreve no memo2 o email
              if (FoundAT = True) and (FoundDOT = True) then
                Begin
                  AWord := '';
                  Memo2.Lines.Add('Email = ' + AEmail);
                End;
            End;
        End;
    End;
end;

I hope I have helped. Any questions please let me know.

    
28.09.2017 / 18:47