IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V < 1 2  
 Ответить  Открыть новую тему 
> Список с заглавным звеном, из текстового файла получить список из записей и по нему уже сделать з
сообщение
Сообщение #21


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


Вот вроде исправил,а всеравно вылетает:
program lyalikov21;
{Найти телефонную сеть(первые 3 цифры номера),имеющую наибольшее число абонентов}
{$APPTYPE CONSOLE}
uses
SysUtils;
type
tPage = record
FIO: string[30];
Ul: string[20];
Dom,Kv: integer;
Tel: string[10];
Bal:single
end;
tlist=^tElem;
tElem = record
Page: tPage;
Next:tlist
end;
var
Spis:tlist;
z:tPage;
x:text;

procedure list_init(var m:tlist);
{Инициализация списка с заглавным звеном}
begin
new(m);
m^.next:=nil
end;

procedure list_read(var z:tPage);
{чтение из файла записи}
begin
readln(x,z.FIO);
readln(x,z.Ul);
readln(x,z.Dom);
readln(x,z.Kv);
readln(x,z.Tel);
readln(x,z.Bal);
if not eof(x) then readln(x)
end;

function more(z1,z2:tPage):boolean;
{Сортировка записи по имени каталога и телефону}
var
t:boolean;
begin
if z1.Tel<z2.Tel then t:=true
else
if z1.Tel=z2.Tel then
if z1.FIO<z2.FIO then t:=true
else
if z1.FIO=z2.FIO then t:=true
else t:=false
else t:=false;
more:=t
end;
procedure list_add(var m:tlist; z:tPage);
{Добавление записи в список, c учетом сортировки}
var
p,q:tlist;
begin
q:=m;
while (q^.next<>nil) and more(q^.next^.Page,z) do
q:=q^.next;
new(p);
p^.Page:=z;
p^.next:=q^.next;
q^.next:=p
end;

procedure list_create(var x:text;var m:tlist);
{Формирование списка из файла}
begin
assign(x,'input.txt');
reset(x);
list_init(m);
while not seekeof(x) do
begin
list_read(z);
list_add(m,z)
end
end;
procedure list_print(m:tlist);
{Печать списка}
begin
if m=nil then writeln('konec spiska')
else
begin
writeln(m^.Page.FIO);
writeln(m^.Page.Ul);
writeln(m^.Page.Dom);
writeln(m^.Page.Kv);
writeln(m^.Page.Tel);
writeln(m^.Page.Bal:3:2);
writeln;
list_print(m^.next)
end
end;
procedure poisk(m:tlist);
var q:tlist;
max,k,i:integer;
maxop:string[3];
begin
q:=m;
max:=0;
while q<>nil do
begin
k:=1;
while (q^.Next^.Page.Tel=q^.Page.Tel) and (q^.Next<>nil) do
begin
k:=k+1;
q:=q^.Next
end;
if k>max then
begin
max:=k;
for i:=1 to 3 do
maxop[i]:=q^.page.tel[i]
end;
q:=q^.Next
end;
dispose(q);
for i:=1 to 3 do
writeln('max operator',maxop[i]);
writeln('vstrechaetsa',max,'raz');
readln;
readln
end;
procedure del(var m:tlist);
{Удаление списка}
var
p:tlist;
begin
while m<>nil do
begin
p:=m;
m:=m^.next;
dispose(p)
end
end;

begin
{ TODO -oUser -cConsole Main : Insert code here }
list_create(x,spis);
Writeln('spisok:');
list_print(spis^.next);
poisk(spis);
close(x);
del(spis);
readln;
readln
end.


При вылете успел сфотать что выдаёт:
Exception EAccessViolation in module lyalikov21.exe at 00008CE2.
Access violation at address 00408CE2 in module 'lyalikov21.exe'. Read of address 0000003C.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #22


Гость






Что-то ты перемудрил в процедуре Poisk. Смотри:

procedure poisk(m: TList);
var
q: TList;
maxOp: string[3];
k, max: integer;
begin
q := m^.next; // первый элемент - пропускаем, он заглавный...
max := 0;
while q <> nil do // а теперь идем по списку...
begin
k := 1; // считать начинаем с 1, одно-то вхождение все равно есть.

// Здесь внимательно: сначала проверим, существует ли q, потом -
// существует ли q^.next, и только потом сравниваем текущий и следующий
// элементы списка...
while (q <> nil) and (q^.next <> nil) and
(copy(q^.page.tel, 1, 3) = copy(q^.next^.page.tel, 1, 3)) do // сравнить первые 3 символа
begin
inc(k);
q := q^.next;
end;

if k > max then // тут у тебя все было правильно, только заполни maxop без цикла
begin
max := k;
maxop := copy(q^.page.tel, 1, 3);
end;

// а вот это - ключевой момент: продвигаемся дальше - только если k = 1,
// то есть, только если внутри предыдущего цикла не было увеличения q...
if k = 1 then
q := q^.next;
end;

writeln('max operator: ', maxop);
writeln('vstrechaetsa: ', max, ' raz(a)');

end;

Вот это только что прогнал на FPC - не вылетает. Учти, я гонял только до закрытия файла, дальше - тебе еще список удалять надо, ты этого так и не сделал... И не надо q^ удалять в Poisk-е. Ты ж место под него ТАМ не выделял, зачем удаляешь?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #23


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


Спасибо большое,исправил,работает) smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V < 1 2
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.10.2020 22:32
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name