Как в memo найти все e-mail'ы

[AVer]

Копирует все мыла ил Memo в ListBox

Function EMailSymbol(C:Char):Boolean;
Type V = set of char;
Var V1:V;
Begin
V1:=['a'..'z','A'..'Z','.','@'];
EMailSymbol:=(C in V1);
End;

Function IsEmail(S:String):Boolean;
Var I:Integer;
    F:Boolean;
Begin
F:=True;
For I:=1 To Length(S) Do
If not EMailSymbol(S[I]) Then F:=False;
IsEmail:=F;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var S,Buf:String;
    I,J:Integer;
begin
S:=Memo1.Text;
While Pos('@',S) <> 0 Do
 Begin
 Buf:='';
 I:=Pos('@',S);
 While EMailSymbol(S[I]) Do
 Inc(I);
 J:=I-1;
 I:=Pos('@',S);
 While EMailSymbol(S[I]) Do
 I:=I-1;
 Inc(I);
 Buf:=Copy(S,I,J);
 Delete(S,I,J);
 While Not IsEMail(Buf) Do
 Delete(Buf,Length(Buf),1);
 ListBox1.Items.Add(Buf);
 End;
end;

[Serge_Bliznykov]

а мне интересно, а почему никто не вспомнил и не предложил использовать регулярные выражения?
например, TRegExpr library

[Черничный]

Сообщение от Роман Радер

а это с какой радости???
зачем два одинаковых выражения (s[i]<>'"') еще на and брать??
и второе, мож я не понял, но при чем тут кавычки?

это условия обрамления мыл в моем контексте! Это от вет человечку, который исходничек выложил выше

[Черничный]

Сообщение от AVer

Копирует все мыла ил Memo в ListBox

Function EMailSymbol(C:Char):Boolean;
Type V = set of char;
Var V1:V;
Begin
V1:=['a'..'z','A'..'Z','.','@'];
EMailSymbol:=(C in V1);
End;

Function IsEmail(S:String):Boolean;
Var I:Integer;
    F:Boolean;
Begin
F:=True;
For I:=1 To Length(S) Do
If not EMailSymbol(S[I]) Then F:=False;
IsEmail:=F;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var S,Buf:String;
    I,J:Integer;
begin
S:=Memo1.Text;
While Pos('@',S) <> 0 Do
 Begin
 Buf:='';
 I:=Pos('@',S);
 While EMailSymbol(S[I]) Do
 Inc(I);
 J:=I-1;
 I:=Pos('@',S);
 While EMailSymbol(S[I]) Do
 I:=I-1;
 Inc(I);
 Buf:=Copy(S,I,J);
 Delete(S,I,J);
 While Not IsEMail(Buf) Do
 Delete(Buf,Length(Buf),1);
 ListBox1.Items.Add(Buf);
 End;
end;

на станичке с контактамаи на mail.ru (html код странички) проерил, на десятока два наврное ящиков вытащил всего два!

[AVer]

Моя задача подсказать решение, а не написать и отладить программу! Я и так сделал большую часть - тебе остается лишь найти ошибку.

[Johnson]

А без дополнительных библиотек регулярные выражения не используются в дэльфи? На php когда писал парсер - поиск мыла занял 4 строки всего...

[Serge_Bliznykov]

Сообщение от Johnson

А без дополнительных библиотек регулярные выражения не используются в дэльфи?

к сожалению, нет...