Текущий архив: 2005.07.11;
Скачать: CL | DM;
Вниз
Поиск 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;
Скачать: CL | DM;
Память: 0.47 MB
Время: 0.052 c
