Extraindo palavras de texto

[Anderson Nunes 0]

Olá pessoal, eis o que preciso. Entrei em uma empresa agora pouco e eles possuem um sistema em delphi 7. Acontece que estão solicitando que bole uma função para o sistema que deverá identificar o email de seus clientes no meio de um texto gigantesco de sua base de dados. Sei que devo usar o identificador @ para identificar o email, mas depois disso, como faço para delimitar o inicio e o fim do mesmo? Acho que é simples, talvez com o primeir5o espaço em branco antes e depois do @. Mas não sei como implementar, alguem ajuda? valeu..abços..

[Fernando-M 0]

Olá pessoal, eis o que preciso. Entrei em uma empresa agora pouco e eles possuem um sistema em delphi 7. Acontece que estão solicitando que bole uma função para o sistema que deverá identificar o email de seus clientes no meio de um texto gigantesco de sua base de dados. Sei que devo usar o identificador @ para identificar o email, mas depois disso, como faço para delimitar o inicio e o fim do mesmo? Acho que é simples, talvez com o primeir5o espaço em branco antes e depois do @. Mas não sei como implementar, alguem ajuda? valeu..abços..

 

 

function PegarPrimeiroArrobaEntreEspacos(S: String): String;
var i, ini, fin: Integer;
begin
  Ini:= -1; Fin:= -1;
  if Pos('@', S) > 0 then begin //Verifica se tem @
    I:= Pos('@', S);
    while I > 0 do begin //Encontra o inicio do e-mail
      if (S[i] = ' ') or (I = 1) then begin
        Ini:= I;
        I:= 0;
      end;
      I:= I - 1;
    end;
    I:= Pos('@', S);
    while I < Length(S)+1 do begin //Encontra o Final do e-mail
      if (S[i] = ' ') or (I = Length(S)) then begin
        Fin:= I;
        I:= Length(S);
      end;
      I:= I + 1;
    end;
  end;
  if (Ini > -1) and (Fin > -1) then
    Result:= Trim(Copy(S, Ini, Fin - Ini + 1))
  else
    Result:= 'Não possui @';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text:= PegarPrimeiroArrobaEntreEspacos('Nome do cliente: Fernando M e-mail: fernando-mm@hotmail.com Site: http://www.autopecasxavier.com.br');
end;

{neste exemplo a function pegara sempre o primeiro e-mail, que tiver entre espaços ou, mesmo que no inicio ou no fim não tenha espaços ex:

 

'fernando-mm@hotmail.com Site: http://www.autopecasxavier.com.br' ou 'Nome do cliente: Fernando M e-mail: fernando-mm@hotmail.com'

 

Agora caso a string venha assim

'Nome do cliente: Fernando M e-mail:fernando-mm@hotmail.com Site: http://www.autopecasxavier.com.br'

ele pegara 'e-mail:fernando-mm@hotmail.com' neste caso terá que substitui : por espaço}

[Anderson Nunes 0]

Obrigado Fernando, agora apenas coloquei todos os caracteres não permitidos para email junto ao " " e ficou bem confiavel. Agora gostaria de saber como faze-la percorrer o memo e pegar todos os emails? abços.

[Fernando-M 0]

coloquei um WHILE e chegou ao seu resultado ele pegar todos os e-mails que tiverem entre espaços. Agora a variavel de result é TStringList em vez de String.

 

function PegarArrobasEntreEspacos(S: String): TStringList;
var i, ini, fin: Integer; Lis: TStringList;
begin
  Lis:= TStringList.Create;
  Ini:= -1; Fin:= -1;
  While Pos('@', S) > 0 do begin //Verifica se tem @
    I:= Pos('@', S);
    while I > 0 do begin //Encontra o inicio do e-mail
      if (S[i] = ' ') or (I = 1) then begin
        Ini:= I;
        I:= 0;
      end;
      I:= I - 1;
    end;
    I:= Pos('@', S);
    while I < Length(S)+1 do begin //Encontra o Final do e-mail
      if (S[i] = ' ') or (I = Length(S)) then begin
        Fin:= I;
        I:= Length(S);
      end;
      I:= I + 1;
    end;
    if (Ini > -1) and (Fin > -1) then
      Lis.Add(Trim(Copy(S, Ini, Fin - Ini + 1)));
    Delete(S, Pos('@', S), 1);
  end;
  Result:= Lis;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.AddStrings(PegarArrobasEntreEspacos('Nome do cliente: Fernando M e-mail: fernando-mm@hotmail.com Site: http://www.autopecasxavier.com.br Nome do Cliente: Monique e-mail: mo.nick@hotmail.com site: http://www.fsist.com.br'));
end;