Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.88/8: Рейтинг темы: голосов - 8, средняя оценка - 4.88
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
1

Справочник e-mail

29.10.2011, 10:45. Просмотров 1396. Ответов 18
Метки нет (Все метки)

Всем привет)Пришла в голову мысль,создать прогамму,которая будет находить в браузере e-mail,копировать себе в форму(либо в блокнот),и каждая следующая запись,будет отделяться ;
т.е.
программа нашла адреса 123@mail.ru,234@yandex.ru,345@box.ru ... итд
В форме она должна написать: 123@mail.ru; 234@yandex.ru; 345@box.ru ...итд
Как это можно реализовать,если вообще можно?
нужна для работы,т.к. часто оповещаем клиентов о работах,и очень тяжко вылавливать по 1 e-mail'у и вписывать в Lotus(Outlook)
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
29.10.2011, 10:45
Ответы с готовыми решениями:

Справочник абитуриента
База вузов,наименование,адрес,перечень специальностей,конкурс прошлого года по...

Мультимедийный справочник (HELP PLEASE!)
помогите пожалуйста найти исходники для создания мультимедийного справочника по...

Не открывается справочник Drkb
Может у кого есть скачанный, или ссылка на работающее зеркало - скачать....

Как дописать телефонный справочник
Есть такой код: unit Unit1; interface uses Windows, Messages,...

Вот народ такое дело! Отправка e-mail
Как сделать из одной программы ну допустим программа одна там есть поля для...

18
anonimus
2154 / 1244 / 143
Регистрация: 28.04.2010
Сообщений: 4,590
29.10.2011, 13:11 2
я писал как-то прогу которая с указанного сайта собирает e-mail адреса могу дать исходник
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 13:12  [ТС] 3
хочу что бы программа записывала почту к себе форму,разделяла ее,и каждый раз при находлении новой почты,снова записывала)
Тупо есть 10 клиентов на 10 разных страницах,хочу что бы прога находило почту,записывала ее себе в форму,и разделяля кажду последующию,и что бы потом скопировать и отравить письмо всем 10рым,а не по 1 копировать самому и вставлять в адресс

как вывести в форму знаю,а как ссдлетаь что бы находилась сама почта?,что бы при просмотре страницы,где есть адресс с почтой,при нажатии кнопки,она записывалась в форму?
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 13:32 4
Сам код извлечения E-Mail адресов из текста, можно спроектировать так:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
procedure GetEmailList(const aStr : String; aSl : TStrings);
const
  //Разделители слов. Точка "." убрана из списка разделителей.
  D = [',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  i, Len, Pos1 : Integer;
  F : Boolean;
begin
  Len := Length(aStr);
  Pos1 := 0;
  F := False;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if aStr[i] in D then Continue;
    //Признак E-Mail.
    if aStr[i] = '@' then F := True;
    //Начало слова.
    if (i = 1) or (aStr[i - 1] in D) then begin
      Pos1 := i;
      F := False;
    end;
    //Конец слова.
    if F and ( (i = Len) or (aStr[i + 1] in D) ) then begin
      aSl.Add( Copy(aStr, Pos1, i - Pos1 + 1) );
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.Clear;
  GetEmailList(Memo1.Text, Memo2.Lines);
end;
Здесь в Мемо1 вводится исходный текст, в Мемо2 записываются найденные ЕМаил адреса.
---
И список разделителей надо расширить:
Delphi
1
2
3
4
5
6
7
const
  //Разделители слов. Точка "." убрана из списка разделителей.
  D = [
    ',', ':', ';', '!', '?', '-', '+', '=', '&', '<', '>',
    '\', '/', '|', '"', '''', '(', ')', '[', ']', '{', '}',
    ' ', #9, #10, #13
  ];
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 13:47  [ТС] 5
т.е. он будет находить все разные адресса,и будет из записывать в поле
но только вопрос?а как будет будет их находить?может ввести символ @ и несколько символов после него,от 3 до 9(допустим),символы состоят из букв от A до Z,но в коде такого нет,или я не правельно всё понял?
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 14:18 6
Цитата Сообщение от smilexcasper Посмотреть сообщение
а как будет будет их находить?
Код выделяет "слова", в которых есть символ "@". Эти слова могут быть различной длины. Можно сделать так, чтобы выбирались не повторяющиеся адреса.
---
Вот вариант, в котором составляется список из не повторяющихся адресов:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
procedure GetEmailList(const aStr : String; aSl : TStrings);
const
  //Разделители слов. Точка "." убрана из списка разделителей.
  D = [
    ',', ':', ';', '!', '?', '-', '+', '=', '&', '<', '>',
    '\', '/', '|', '"', '''', '(', ')', '[', ']', '{', '}',
    ' ', #9, #10, #13
  ];
var
  i, Len, Pos1 : Integer;
  F : Boolean;
begin
  Len := Length(aStr);
  Pos1 := 0;
  F := False;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if aStr[i] in D then Continue;
    //Признак E-Mail.
    if aStr[i] = '@' then F := True;
    //Начало слова.
    if (i = 1) or (aStr[i - 1] in D) then begin
      Pos1 := i;
      F := False;
    end;
    //Конец слова.
    if F and ( (i = Len) or (aStr[i + 1] in D) ) then begin
      aSl.Add( AnsiLowerCase(Copy(aStr, Pos1, i - Pos1 + 1)) );
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Sl : TStringList;
begin
  Sl := TStringList.Create;
  Sl.Sorted := True;
  //Запрещаем добавлять в список повторы.
  Sl.Duplicates := dupIgnore;
  GetEmailList(Memo1.Text, Sl);
  Memo2.Lines.Assign(Sl);
  FreeAndNil(Sl);
end;
И из списка резделителей убрал точку: ".".
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 14:22  [ТС] 7
ок)
т.е. добавить кнопку,вписать код в нее,и будет работать?
каждый раз при нажатии кнопки будет добавляться найденные адреса в браузере?
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 14:32 8
Центральная часть кода - это процедура GetEmailList(). Она извлекает список адресов из текста (и из HTML кода, в том числе). Для демонстрации работы этой процедуры, на форму добавлены: Мемо1 - в него вводится исходный текст (HTML код, например); Мемо2 - в него выводится список Е-Маил адресов без повторов.
Но непосредственно с браузером эта программа не работает. Это ещё надо дописывать.
---
Можно взять исходный HTML код страницы из браузера и скопировать его в Мемо1. Тогда при нажатии на кнопку, в Мемо2 появится список Е-Маил адресов без повторов.
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 14:38  [ТС] 9
как ее можно доработать что бы она сама находила в браузере адресс,и при нажатие вводила в мемо?)
не обязательно код,нужна сама идея)

Добавлено через 2 минуты
как нибуть вроде при нажатии на другую кнопку,в открытом браузере на активной страницы копируеться код,который вводиться в мемо0,и тогда уже остальная часть кода,такое возможно?
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 14:42 10
Можно, например, так - в Edit на форме вводится URL страницы, программа закачивает по этому URL содержимое страницы, после этого, исходный HTML код можно обработать через вызов GetEmailList().
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 14:50  [ТС] 11
ну это не как не повлияет на работоспособность)всё те же действия)
а по другому не как вообще?(
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 14:56 12
Вот, например, способ. В Edit1 вводится URL страницы, нажимается кнопка и в Мемо1 выводится список Е-Маил адресов без повторов:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
procedure GetEmailList(const aStr : String; aSl : TStrings);
const
  //Разделители слов. Точка "." убрана из списка разделителей.
  D = [
    ',', ':', ';', '!', '?', '-', '+', '=', '&', '<', '>',
    '\', '/', '|', '"', '''', '(', ')', '[', ']', '{', '}',
    ' ', #9, #10, #13
  ];
var
  i, Len, Pos1 : Integer;
  F : Boolean;
begin
  Len := Length(aStr);
  Pos1 := 0;
  F := False;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if aStr[i] in D then Continue;
    //Признак E-Mail.
    if aStr[i] = '@' then F := True;
    //Начало слова.
    if (i = 1) or (aStr[i - 1] in D) then begin
      Pos1 := i;
      F := False;
    end;
    //Конец слова.
    if F and ( (i = Len) or (aStr[i + 1] in D) ) then begin
      aSl.Add( AnsiLowerCase(Copy(aStr, Pos1, i - Pos1 + 1)) );
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Sl : TStringList;
  S : String;
begin
  S := IdHTTP1.Get( Edit1.Text );
  Sl := TStringList.Create;
  Sl.Sorted := True;
  //Запрещаем добавлять в список повторы.
  Sl.Duplicates := dupIgnore;
  GetEmailList(S, Sl);
  Memo1.Lines.Assign(Sl);
  FreeAndNil(Sl);
end;
Например, если в Edit ввести адрес этой темы на форуме: Справочник e-mail то в Мемо1 будет выведен список Е-Маил адресов:
Код
123@mail.ru
234@yandex.ru
345@box.ru
rating@mail.ru
рейтинг@mail.ru
---
И на форму надо добавить компонент: TIdTTTP с закладки Indy Clients палитры компонентов.
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 14:59  [ТС] 13
круто))
а если файл не хтмл страница,а например ексел,как тогда?)
и как сделать что б мемо выводило все в строку,и разделяла адреса ;
потому что все равно придеться копировать по одной и знаки самим ставить)
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 15:11 14
Цитата Сообщение от smilexcasper Посмотреть сообщение
и как сделать что б мемо выводило все в строку,и разделяла адреса ;
Можно так сделать:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.Button1Click(Sender: TObject);
var
  Sl : TStringList;
  S : String;
begin
  S := IdHTTP1.Get( Edit1.Text );
  Sl := TStringList.Create;
  Sl.Sorted := True;
  //Запрещаем добавлять в список повторы.
  Sl.Duplicates := dupIgnore;
  GetEmailList(S, Sl);
  Sl.Delimiter := ';';
  Memo1.Text := Sl.DelimitedText;
  FreeAndNil(Sl);
end;
Цитата Сообщение от smilexcasper Посмотреть сообщение
а если файл не хтмл страница,а например ексел,как тогда?)
Можно и из Excel данные взять. И из Word. Сейчас напишу...
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 15:23  [ТС] 15
Офигеть)надеюсь когда получу 2 образование,буду так же штопать программы)
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 15:37 16
Код с возможностью сбора E-Mail адресов из интернета по заданному URL и из книги MS Excel:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
uses
  ComObj;
 
procedure GetEmailList(const aStr : String; aSl : TStrings);
const
  //Разделители слов. Точка "." убрана из списка разделителей.
  D = [
    ',', ':', ';', '!', '?', '-', '+', '=', '&', '<', '>',
    '\', '/', '|', '"', '''', '(', ')', '[', ']', '{', '}',
    ' ', #9, #10, #13
  ];
var
  i, Len, Pos1 : Integer;
  F : Boolean;
begin
  Len := Length(aStr);
  Pos1 := 0;
  F := False;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if aStr[i] in D then Continue;
    //Признак E-Mail.
    if aStr[i] = '@' then F := True;
    //Начало слова.
    if (i = 1) or (aStr[i - 1] in D) then begin
      Pos1 := i;
      F := False;
    end;
    //Конец слова.
    if F and ( (i = Len) or (aStr[i + 1] in D) ) then begin
      aSl.Add( AnsiLowerCase(Copy(aStr, Pos1, i - Pos1 + 1)) );
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Sl : TStringList;
  S : String;
begin
  S := IdHTTP1.Get( Edit1.Text );
  Sl := TStringList.Create;
  Sl.Sorted := True;
  //Запрещаем добавлять в список повторы.
  Sl.Duplicates := dupIgnore;
  GetEmailList(S, Sl);
  Sl.Delimiter := ';';
  Memo1.Text := Sl.DelimitedText;
  FreeAndNil(Sl);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  exApp, exBook, exSh, exUsRng : Variant;
  S : String;
  i, Row, Col : Integer;
  Sl : TStringList;
  Od : TOpenDialog;
begin
  Od := OpenDialog1;
  if Od.InitialDir = '' then
    Od.InitialDir := ExtractFilePath(ParamStr(0))
  ;
  if not Od.Execute then Exit;
  if not FileExists(Od.FileName) then begin
    Exit;
    ShowMessage('Файл с заданным именем не найден. Действие отменено.');
  end;
  //Пытаемся запустить Excel и подключиться к нему.
  try
    exApp := CreateOleObject('Excel.Application');
  except
    ShowMessage('Не удалось подключиться к MS Excel. Действие отменено.');
    Exit;
  end;
 
  //На время отладки делаем окно Excel видимым.
  exApp.Visible := True;
  //Открываем файл рабочей книги.
  exBook := exApp.Workbooks.Open(FileName:=Od.FileName);
 
  //Создаём и настраиваем объект списка.
  Sl := TStringList.Create;
  Sl.Sorted := True;
  Sl.Duplicates := dupIgnore;
 
  //Перебор всех листов в рабочей книге.
  for i := 1 to exBook.Worksheets.Count do begin
    //Подключение к i-у листу рабочей книги.
    exSh := exBook.Worksheets[i];
    //Определяем рабочий диапазон.
    exUsRng := exSh.UsedRange;
    //Перебираем все ячейки диапазона и извлекаем из них записи Е-Маил адресов.
    for Row := 1 to exUsRng.Rows.Count do
    for Col := 1 to exUsRng.Columns.Count do begin
      S := exUsRng.Cells[Row, Col].Text;
      GetEmailList(S, Sl);
    end;
  end;
 
  //Показыавем список в Мемо1.
  Sl.Delimiter := ';';
  Memo1.Text := Sl.DelimitedText;
 
  //Удаляем список из памяти.
  FreeAndNil(Sl);
 
  //Закрываем книгу и выходим из Excel.
  //На время отладки отключено.
  //exBook.Close;
  //exApp.Quit;
end;
Можно ещё взятие адресов из MS Word добавить - но это если в самом деле нужно, тогда допишу.
0
Миниатюры
Справочник e-mail  
Вложения
Тип файла: rar GetEMailList.rar (237.3 Кб, 19 просмотров)
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 15:48  [ТС] 17
Ворд не нужен)адресса находяться только в браузере или в екселе)
а вот если будет страница вход которую требует пароль,не получаеться
пробывал ввести адрес своей почты,и адресс биллинга,не фурычит(
0
Mawrat
12827 / 5735 / 1700
Регистрация: 19.09.2009
Сообщений: 8,807
29.10.2011, 15:55 18
Цитата Сообщение от smilexcasper Посмотреть сообщение
а вот если будет страница вход которую требует пароль,не получаеться
пробывал ввести адрес своей почты,и адресс биллинга,не фурычит(
Вот если требуется ввод логина и пароля - здесь всё сложнее. Это надо разобрать HTML код, найти компоненты, которые предназначены для ввода логина и пароля. Также, надо найти компонент, который ответственный за передачу данных HTML формы (теги HTML формы: <form></form>). И прочее...
---
Можно ещё решить вопрос подключения к браузеру, в котором пройдена регистрация (с вводом пароля) и уже загружена нужная страница. Здесь ещё надо думать как сделать... Можно попробовать применить компонент TWebBrouser. Или попытаться подключиться к внешнему браузеру.
0
smilexcasper
0 / 0 / 0
Регистрация: 29.10.2011
Сообщений: 14
29.10.2011, 15:58  [ТС] 19
ужас))
Спасибо Вам больше)Будем адресса забивать в ексель)

Добавлено через 10 секунд
/close
0
29.10.2011, 15:58
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
29.10.2011, 15:58

Delphi: отправка отчета на mail с помощью frxMailExport
Всем добрый день. Впервые столкнулся с frxMailExport. Возник такой вопрос, как...

тел.Справочник
плииииз. помогите написать тел.Справочник

Справочник. Теория.
У меня на сервере в БД есть большой 3-х уровневый справочник: 1 ур. - &quot;Группа&quot;...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
19
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru