Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.57/7: Рейтинг темы: голосов - 7, средняя оценка - 4.57
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
1

Отсортировать список email-адресов

20.01.2015, 19:23. Показов 1418. Ответов 13
Метки нет (Все метки)

Здравствуйте.

Программу ниже компилирую Pascal ABC, компилятор никаких ошибок не выдает. Пр запуске в скомпилированном виде открывается интерфейс командной строки, не зависает (спокойно закрывается), но ничего не происходит.
что не так?

В файлу input.txt email адреса, по одному адресу в строке. Их нужно отсортировать.
Pascal
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
Uses CRT;
 
var 
t,t2,t3,t4,t5,t6:text; st,sub: string; 
 
begin
 
assign (t,'input.txt');
reset(t);
 
while not EOF do
   begin
readln(t, st);
sub:=st;
 
while sub[1]<>'@' do begin  
            delete (sub,1,1); end;
if (sub='@yandex.ru') or (sub='@ya.ru') or (sub='yandex.com') or (sub='yandex.com.tr') or (sub='@narod.ru') then
begin
assign (t2,'yandex.txt');
rewrite(t2);
writeln (t2, st);
end;
 
if (sub='@gmail.com') or (sub='googlemail.com') then
begin
assign (t3,'gmail.txt');
rewrite (t3);
writeln (t3, st);
end;
 
if (sub='@rambler.ru') or (sub='@ro.ru') or (sub='@r01.ru') then
begin
assign (t4, 'rambler.txt');
rewrite (t4);
writeln (t4, st);
end;
 
if (sub='@mail.ru') or (sub='@bk.ru') or (sub='@list.ru') then
begin
assign (t5, 'mail.ru.txt');
rewrite (t5);
writeln (t5, st)
end
 
else 
begin
assign (t6, 'other.txt');
rewrite (t6);
writeln (t6, st);
end;
         end;
         
 close (t);
 close (t2);
 close (t3);
 close (t4);
 close (t5);
 close (t6);
 
 writeln ('Работа завершена ');
 repeat delay(1) until keypressed;
 end.
Спасибо.
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
20.01.2015, 19:23
Ответы с готовыми решениями:

Определить маску для разбиения на подсети и список возможных IP-адресов подсетей.
Разработать приложение, которое по заданному классу (А, В или С), количеству подсетей N и...

Отсортировать список почтовых адресов по доменам
Ребят нужна срочно помощь Имеется база email разных доменов тоисть yandex.ru mail.ru rambler.ru...

Получение email-адресов со страницы
вообщем решил собрать мыла с http://***************/ мыла в HTML коде выглядят таким образом &lt;img...

Создать оболочку для онлайн-сервиса верификации email-адресов
Никак не могу разобраться с Post-запросами. Необходимо хотя бы увидеть толковый исходник. В общем,...

13
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
20.01.2015, 19:44 2
Цитата Сообщение от mikhailnov Посмотреть сообщение
Спасибо.
Так может пример файла выложишь, а то для тестирования лень придумывать.

Добавлено через 3 минуты
Pascal
1
2
while not EOF do
   begin
И на это программа не шипит?
0
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
20.01.2015, 19:48  [ТС] 3
Не шипит. Заменил это на
Pascal
1
2
repeat  
            delete (sub,1,1) until st[1]='@';
результат тот же.
А что не так было? do не надо?

Содержимое input.txt:
vasya@gmail.com
petya@mail.ru
bbb@bk.ru[/email]
nnn@yandex.ru
sik@rambler.ru
Как прикрепить сюда сам файл, не нашел.
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
20.01.2015, 19:49 4
Цитата Сообщение от mikhailnov Посмотреть сообщение
Как прикрепить сюда сам файл,
Читай, малограмотный, ссылка под окном сообщений.
https://www.cyberforum.ru/abou... 03521.html
0
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
20.01.2015, 19:49  [ТС] 5
В общем, набор произвольных email и все
0
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
20.01.2015, 19:55  [ТС] 6
Вот.
0
Вложения
Тип файла: txt input.txt (74 байт, 1 просмотров)
Тип файла: zip 2.zip (17.7 Кб, 3 просмотров)
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
20.01.2015, 19:55  [ТС] 7
В архиве исходники паскаля, скомпилированная программа, input.txt
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
20.01.2015, 20:42 8
Pascal
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
Uses CRT;
var t,t2,t3,t4,t5,t6:text; 
    st,sub: string; 
begin
assign (t,'input.txt');
reset(t);
assign (t2,'yandex.txt');
rewrite(t2);
assign (t3,'gmail.txt');
rewrite (t3);
assign (t4, 'rambler.txt');
rewrite (t4);
assign (t5, 'mail.ru.txt');
rewrite (t5);
assign (t6, 'other.txt');
rewrite (t6);
while not EOF(t) do//говорил тебе нельзя писать без параметра!!!!
 begin
  readln(t, st);
  sub:=st;
  while sub[1]<>'@' do delete (sub,1,1);
  if (sub='@yandex.ru') or (sub='@ya.ru') or (sub='yandex.com') or (sub='yandex.com.tr') or (sub='@narod.ru')
  then writeln (t2, st)
  else if (sub='@gmail.com') or (sub='googlemail.com') then writeln (t3, st)
  else if (sub='@rambler.ru') or (sub='@ro.ru') or (sub='@r01.ru') then writeln (t4, st)
  else if (sub='@mail.ru') or (sub='@bk.ru') or (sub='@list.ru') then writeln (t5, st)
  else writeln (t6, st);
 end;
 close (t);
 close (t2);
 close (t3);
 close (t4);
 close (t5);
 close (t6);
 writeln ('Работа завершена ');
end.
Если пишешь в АВС.net то в том разделе и создавай темы, а не пудри мозги.
0
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
20.01.2015, 20:51  [ТС] 9
Некорректно работает - все email скидывает в other.txt
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
20.01.2015, 21:09 10
Не знаю что ты та творишь, но из твоего файла inpur у меня в mail.ru попало 2 ящика, в rambler 1 ящик в gmail 1 ящик в yandex 1 ящик в other ни одного
1
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
20.01.2015, 22:51  [ТС] 11
Да, с тем input.txt работает, спасибо тебе большое за помощь.

Но вот с большим inut, который во вложении, он работает неправильно: первую в нем почту @yandex.ru кидает в yandex.txt, как надо, а остальные почты кидает в other.txt. Если убрать первую почту @yandex.ru и первой станет @mail.ru, то вообще все уходит в other.txt

[cut] - большой input
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
21.01.2015, 08:33 12
В конце всех строк, кроме первой, какие-то не читаемые символы. Я пробовал их удалить как пробелы, не получилось, потом как пробелы и знаки табуляции, тоже не получилось, потом сделал так
Pascal
1
2
3
4
5
6
while not EOF(t) do
 begin
  readln(t, st);
  //удалим все не латинские маленькие буквы с конца строки
  while not(st[length(st)]in ['a'..'z']) do delete(st,length(st),1);
  sub:=st;
1
0 / 0 / 0
Регистрация: 20.01.2015
Сообщений: 12
21.01.2015, 16:10  [ТС] 13
Спасибо, дружище, очень помог!

Добавлено через 1 час 29 минут
С тем инпутом на 60 тысяч прога отработала прекрасно.

Только еще проблема. Скормил программе input с 2,5 млн адресов, массив вышел за допустимые пределы (ошибка при выполнении программы). Это какие-то ограничения паскаля или что? Можно как-то вылечить?

https://yadi.sk/d/ST9wBFH5e8wNG

Нынешний код программы:

Pascal
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
Uses CRT;
var t,t2,t3,t4,t5,t6:text; 
    st,sub: string; 
begin {программу помогли написать здесь: [url]https://www.cyberforum.ru/pascalabc/thread1358204.html[/url] Puporev отдельное спасибо за помощь}
assign (t,'input.txt');
reset(t);
assign (t2,'yandex.txt');
rewrite(t2);
assign (t3,'gmail.txt');
rewrite (t3);
assign (t4, 'rambler.txt');
rewrite (t4);
assign (t5, 'mail.ru.txt');
rewrite (t5);
assign (t6, 'other.txt');
rewrite (t6);
while not EOF(t) do
 begin
  readln(t, st);
   //удалим все не латинские маленькие буквы с конца строки
  while not(st[length(st)]in ['a'..'z']) do delete(st,length(st),1);
  sub:=st;
  while sub[1]<>'@' do delete (sub,1,1);
  if (sub='@yandex.ru') or (sub='@ya.ru') or (sub='yandex.com') or (sub='yandex.com.tr') or (sub='@yandex.ua') or (sub='@yandex.by') or (sub='@narod.ru')
  then writeln (t2, st)
  else if (sub='@gmail.com') or (sub='googlemail.com') then writeln (t3, st)
  else if (sub='@rambler.ru') or (sub='@ro.ru') or (sub='@r01.ru') then writeln (t4, st)
  else if (sub='@mail.ru') or (sub='@bk.ru') or (sub='@list.ru') or (sub='@inbox.ru') then writeln (t5, st)
  else writeln (t6, st);
 end;
 close (t);
 close (t2);
 close (t3);
 close (t4);
 close (t5);
 close (t6);
 writeln ('Работа завершена ');
end.
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
21.01.2015, 17:13 14
В Паскаль АВС.net убрал модуль Crt, абсолютно ненужный и убрал проверку конца строк, в новом файле нет лишних символов и все работает, правда читает секунды 3. То же в Делфи намного быстрее.
Pascal
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
var t,t2,t3,t4,t5,t6:text;
    st,sub: string;
    i:byte;
begin
assign (t,'input.txt');
reset(t);
assign (t2,'yandex.txt');
rewrite(t2);
assign (t3,'gmail.txt');
rewrite (t3);
assign (t4, 'rambler.txt');
rewrite (t4);
assign (t5, 'mail.ru.txt');
rewrite (t5);
assign (t6, 'other.txt');
rewrite (t6);
while not EOF(t) do
 begin
  readln(t, st);
  sub:=st;
  while sub[1]<>'@' do delete (sub,1,1);
  if (sub='@yandex.ru') or (sub='@ya.ru') or (sub='yandex.com') or (sub='yandex.com.tr') or (sub='@narod.ru')
  then writeln (t2, st)
  else if (sub='@gmail.com') or (sub='googlemail.com') then writeln (t3, st)
  else if (sub='@rambler.ru') or (sub='@ro.ru') or (sub='@r01.ru') then writeln (t4, st)
  else if (sub='@mail.ru') or (sub='@bk.ru') or (sub='@list.ru') then writeln (t5, st)
  else writeln (t6, st);
 end;
 close (t);
 close (t2);
 close (t3);
 close (t4);
 close (t5);
 close (t6);
 writeln ('Работа завершена ');
end.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
21.01.2015, 17:13

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Регулярное выражение для пропуска email-адресов только указанных доменов
Привет всем, помогите пожалуйста: нужно регулярное выражение, а именно чтоб пропускало e-mail...

Список IP адресов
Доброго времени суток форумчане подскажите как получить список всех ip локальной сети?

Список ip-адресов в сети
Всем доброго времени суток. Возможно ли вывести в ComboBox или Memo список ip-адресов всех...

Список IP-адресов в локальной сети
Как, зная адрес и маску подсети, с помощью Windows API получить список IP всех хостов? ...


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

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

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