Форум: "Основная";
Текущий архив: 2005.07.11;
Скачать: [xml.tar.bz2];

Вниз

Поиск email в тексте TMemo   Найти похожие ветки 

← →
4ubaka   (2005-06-11 13:20) [0]

Добрый день. Пишу программу, которая умеет выделять(находить) все адреса email в тексте TMemo.
Написал алгоритм, который находит положение @ в тексте, а потом копирует по одному символу с каждой стороны от @ пока не встретиться пробел или кавычки. Но он не работает.
Может кто-то сталкивался с подобной задачей? Помогите! Можно на email: kev89@mail.ru

---

← →
TUser ©   (2005-06-11 13:23) [1]

> Написал алгоритм, который находит положение @ в тексте, а потом копирует по одному символу с каждой стороны от @ пока не встретиться пробел или кавычки. Но он не работает.

Выделенные жирным слова противоречат друг другу. А вообще - спамерам - бой!

---

← →
Homa_Programer ©   (2005-06-11 13:29) [2]

а что за ошибка то вылазит? в чем проблема... вроде смысл правильный... а вот как реализовано у тебя?!

---

← →
4ubaka   (2005-06-11 13:31) [3]

Ошибка как раз не вылазит, вообще ничего не вылазит.
И я не спамер.

procedure TForm1.emailerExecute(Sender: TObject);
var
i,n:integer;
s:string;
begin
n:=length(memo1.Text);
while i < n do
begin
 i:=pos("@",memo1.Text);
 CheckListBox1.Items.Insert(0,DetectAddress(i));
end;
end;

function TForm1.DetectAddress(posn: integer): string;
var
start,fin,s,f:string;
d,n,i:integer;
begin
 for i:=0 to 100 do
  begin
    f:=copy(memo1.Text,posn-i,1);
     while not (f=" ") do
      begin
        start:=f+start;
      end;
      if f=" " then
      break;
  end;

  for i:=0 to 100 do
   begin
     f:=copy(memo1.Text,posn+i,1);
      while not (f=""") or not (f=" ") do
       begin
        fin:=f+fin;
       end;
       if (f=""") or (f=" ") then
       break;
    end;
    result:=start+"@"+fin;
end;

---

← →
-=XP=- ©   (2005-06-11 13:50) [4]

SPAMERS MUST DIE

---

← →
TUser ©   (2005-06-11 13:53) [5]

Что-то вроде этого, только учти, что этот подход ни в коем случае не является универсальным. Например, существуют концы строки и другие символы, которые никак не могут быть в составе адреса.

procedure FindAddressesInMemo (SL: TStrings);
var i: integer;
   start, finish: integer;
   state: smallint;

procedure Proceed (C: char);
begin
   case C of
     " ", """:
      begin
        if state = 3 then
          SL.Add(copy(Memo1.Lines,Text,start,finish-start+1));
        state:=0;
      end;
     "@":
      if state = 1 then begin        
        inc (finish); state:=2;
        end;
     else
      begin
        if state = 0 then begin
          state:=1; start:=i; finish:=i-1;
          end else
        if state = 2 then
          state = 3;
        inc (finish);
      end;
     end;

end;

begin
 state:=0;
 for i:=1 to length(Memo1.Lines.Text) do
   Proceed(Memo1.Lines.Text[i]);
 Proceed(" ");
end;

---

← →
4ubaka   (2005-06-11 17:05) [6]

Удалено модератором

---

← →
iskatel ©   (2005-06-11 18:29) [7]

короче тебе прямая дорога regexp - ы изучать, они тебе помогут, можешь попробовать TRegExp, но он слабоват, покруче будет VbScript Regular Expression - ставится вместе с оффисом, но можно отдельно dll  перетащить - но придется юзать COM

---

← →
TUser ©   (2005-06-11 18:59) [8]

> iskatel ©   (11.06.05 18:29) [7]

Регулярными выражениями адреса вытаскивать - это как из пушки по воробьям.

---

← →
iskatel ©   (2005-06-11 19:48) [9]

зря ты так - использовать их не сложно, особенно TRegExp, зато вытащит наверняка, и на всякие левые @ не среагирует...

---

← →
Николай,гер   (2005-06-12 14:27) [10]

Удалено модератором
Примечание: Ник измени

---

← →
Николай,герм   (2005-06-12 19:30) [11]

у меня есть другой варант :
только коментов мало .

procedure TForm1.BitBtn1Click(Sender: TObject);
var
mail, text, affeN:string;
k ,i,anzh,voranzh: integer;
begin
k:=0;
affeN:="";
text := RichEdit1.Text;
for i:=0 to Length(text) do
begin

  if ("@"= Copy(text,i-1,1)) then
   begin
     k:=k+1;
     BitBtn1.Caption:= IntToStr(k);
     anzh:=0;
   // Найти после  @
    repeat
      anzh:=anzh+1;
    until ("""= Copy(text,i+anzh,1));

  // Найти до @
    voranzh:=i;
    repeat
      voranzh:=voranzh-1;
    until (":"= Copy(text,voranzh,1));

    affeN:= Copy(text,voranzh+1,(i-voranzh+anzh-1))+ " ";
    voranzh:=0;
    mail := mail + affeN;
    affeN:="";
   end;
end;
 Richedit2.Lines.Add(mail) ;

 BitBtn1.Caption:= "Finden mails und anzeigen  mails adressen gefunden Anzahl : " + IntToStr(k);
 RichEdit1.Clear;
end;


моэет кому поможет.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.07.11;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.179 c