Доработать И Исправить Ошибку В Информационно-справочной Системе

[Noya]

Помогите пожалуйста доработать программу.
Условие задачи: Разработать информационно-справочную систему коммерческих магазинов города. Предусмотреть поиск названия магазина и его адрес по названию товара. Результатом поиска является отсортированный в порядке возрастания стоимости искомого товара список магазинов. Данные располагать в динамической памяти компьютера в виде связанного списка.
НАДО добавить чтобы было 2 связанных списка: 1-магазин, адрес; 2-товар,цена.
например: Магазин1 Адрес1 товар1 цена1
товар2 цена2
Магазин2 Адрес2 ..... .............
Заранее Спасибо за помощь!!!
Вот моя написанная программа:

uses crt;
type TList=^TNode;
tlist2=^tnode2;
sv=record
mag,adre:string[150];
kod:integer;
end;
sv2=record
ntov:string[200];
cena,kod:longint;
end;
TNode=record info:sv; next:TList;
end;
tnode2=record info:sv2;next:tlist2;end;
var
f: file of sv;
f2:file of sv2; {f - Файл с базой данных}
List:TList;
list2:tlist2; {list - переменная списка}
a,b:sv; {a - переменная для временного хранения записи,b-переменная для хранения критерия для отбора}
a2,b2:sv2;
i,kol,w,nb:integer; {i - переменная для цикла ввода авто,kol - перменная колличества авто для создания базы}
{w - переменная меню, nb - переменная для поиска определенной записи}

Procedure ListInit (var L:TList);
begin
l:=nil;
end;

Procedure ListClear (var L:TList);
var e:TList;
begin
While l<>nil do
begin
e:=l;
l:=l^.next;
dispose(e);
end;
end;
Procedure ListInit2 (var L2:TList2);
begin
l2:=nil;
end;

Procedure ListClear2 (var L2:TList2);
var e:TList2;
begin
While l2<>nil do
begin
e:=l2;
l2:=l2^.next;
dispose(e);
end;
end;


Procedure AddLast (var L:TList; c:sv);
var q,p:Tlist;
begin
New(q);
q^.info:=c;
q^.next:=nil;
if l=nil then l:=q
else
begin
p:=l;
while p^.next<>nil do
p:=p^.next;
p^.next:=q;
end;
end;

Procedure AddLast2 (var L:TList2; c:sv2);{Добавление узла в конец списка}
var q,p:Tlist2;
begin
New(q); {Создание узла}
q^.info:=c; {Добавление в него информации}
q^.next:=nil; {Присвоение ему конца}
if l=nil then l:=q {Если список пустой, то присвоить ему узел}
else
begin
p:=l; {Чтобы не потерять начало списка}
while p^.next<>nil do {Перебор списка до предпоследнего элемента}
p:=p^.next; {Перход к следующему}
p^.next:=q; {Добавление элемента}
end;
end;

Procedure Wwod(var L:TList; var l2:tlist2); {Создание списка}
var p:tlist;n:tlist2;
begin
ListClear(list); {Очищение старого списка}
ListInit(list); {Инициализация нового}
ListClear2(list2); {Очищение старого списка}
ListInit2(list2);
Writeln(' '); { запись информации}
Writeln('Кол-vo magazinov: ');
Readln(kol);
for i:=1 to kol do
begin
Writeln(' magazin',i);
with a do
begin
kod:=i;
writeln('Название mag ');
readln(mag);
writeln('adres ');
readln(adre);
{writeln('naz tovara - ');
readln(ntov);
writeln('Цена - ');
readln(cena);}

end;
addlast(l,a); {Добавление информации в конец списка}
end;
p:=l;
while p<>nil do
begin
writeln('Kol-vo tovara v magazine - ',p^.info.mag,' = ');
readln(kol);
for i:=1 to kol do begin
with a2 do
begin
kod:=p^.info.kod;
writeln('name tovara - '); readln(ntov);
writeln('Cena - ');readln(cena);
end;
addlast2(l2,a2); end;
p:=p^.next;
end;
Writeln;
end;

Procedure ListPrint (L:TList;l2:tlist2); {Вывод списка на экран}
begin
writeln(' naz mag adres naz tovara Цена ');
While l<>nil do {Перебор списка до конца}
begin
with l^.info do {Блок вывода информации из элемента}
begin
write (mag:5,' ',adre:10);
while (kod=l2^.info.kod) and (l2<>nil) do begin
writeln(' ',l2^.info.ntov,' ',l2^.info.cena);
l2:=l2^.next;
end;
end;
l:=l^.next; {Переход к следующему}
end;
Writeln;
Writeln('Нажмите Enter для продолжения');
readln;
clrscr;
end;

Procedure SaveIt(L:TList;l2:tlist2); {Сохранение списка в файл}
begin
assign(f,'kati.dat');
rewrite(f);
assign(f2,'kati2.dat'); {На перезапись}
rewrite(f2);
While l<>nil do {Перебор списка}
begin
write(f,l^.info); {Запись информационной части в файл}
while l^.info.kod=l2^.info.kod do
begin
write(f2,l2^.info);
l2:=l2^.next;
end;
l:=l^.next; {Переход к следующему элементу}
end;
close(f);
close(f2);
end;

{procedure Moder(var L:TList); {Изменение записи}
{var p:tlist;
begin
i:=0;
writeln('номер magazine - ');
readln(nb);
p:=l;
while p<>nil do {Перебор списка}
{begin
inc(i);
if i=nb then {Если номер найден тогда}
{begin { перезаписываем элемент}
{with a do begin
writeln('Название mag ');
readln(mag);
writeln('adres ');
readln(adre);
writeln('naz tovara - ');
readln(ntov);
writeln('Цена - ');
readln(cena);
end;
p^.info:=a; {Запись информации в элемент}
{end;
p:=p^.next; {Следующий элемент списка}
{end;
Writeln;
Writeln('Модернизация записи завершена (нажмите Enter для продолжения )');
Writeln;
Readln;
SaveIt(list);
end;}

{Procedure Dob(var L:TList); {Добавление новой записи}
{begin
Writeln;
writeln('Введите данные об magazine:');
with a do begin
writeln('Название mag ');
readln(mag);
writeln('adres ');
readln(adre);
writeln('naz tovara - ');
readln(ntov);
writeln('Цена - ');
readln(cena);
end;
AddLast(l,a); {Добавление в конец}
{Writeln;
Writeln('Нажмите Enter для продолжения');
Writeln;
Readln;
SaveIt(list);
end;}

Procedure Sort(var q:TList; var q2:tlist2);
var p,n:TList;
c:sv;
p2,n2:tlist2;
c2:sv2;
begin
p:=q;
p2:=q2;

while p2<>nil do {Перебор всего списка}
begin
n2:=p2;

while n2<>nil do
begin {Перебор спика без элементов из 1 цикла}
if p2^.info.cena>=n2^.info.cena then
begin
c2:=p2^.info;
p2^.info:=n2^.info;
n2^.info:=c2;

c:=p^.info;
p^.info:=n^.info;
n^.info:=c;
p:=p^.next;
n:=n^.next;
end;

n2:=n2^.next; {следующий элемент 2 цикла}
end;
p2:=p2^.next; {следующий элемент 1 цикла}
end;

clrscr;
ListPrint(q,q2);

end;


Procedure Sort2(var L:TList;l2:tlist2);
var p,n:TList;
p2,n2:tlist2;
krit:integer;
c:sv;c2:sv2;
it:string;
begin
p:=nil;p2:=nil;

n:=l; n2:=l2;
writeln('naz tovara dli poiska'); readln(it);
while n<>nil do
begin
while n^.info.kod=n2^.info.kod do
begin
if n2^.info.ntov=it then begin c:=n^.info; addlast(p,c); c2:=n2^.info; addlast2(p2,c2);end;
n2:=n2^.next;
end;
n:=n^.next;
end;
sort(p,p2);
end;



begin
w:=0;
ListInit(list); { считываем информацию из файла и записываем ее в список}
listinit2(list2);
i:=1;

assign(f,'kati.dat');
reset(f);
While not eof(f) do
begin
inc(i);
read(f,a);
AddLast(list,a);
end;
close(f);

assign(f2,'kati2.dat');
reset(f2);
While not eof(f2) do
begin
inc(i);
read(f2,a2);
AddLast2(list2,a2);
end;
close(f2);
while w<>7 do begin
writeln(' меню программы:');
writeln('1-Создание базы данных');
writeln('2-Полный список mag');
{writeln('3-Модернизация информации oб mag');
writeln('4-poisk po nazvan');
writeln('5-Добавление mag'); }
writeln('6-poisk tovarov po nazvaniu');
writeln('7-Выход из программы');
write(' Ваш выбор- ');
readln(w); clrscr;
case w of
1:Wwod(list,list2);
2:ListPrint(list,list2);
{3:Moder(list); }
{4:Sort(list);}
{5ob(list);}
6:Sort2(list,list2);
end;
clrscr;
end;
SaveIt(list,list2); {Перезапись списка в файл}
ListClear(List); {Очищение списка}
listclear2(list2);
clrscr;
writeln('Программа завершена!');
end.

 

[nayke]

Помогите пожалуйста доработать программу.

множество текста и ничего конкретного.
Непонятно даже delphi это или паскаль.
Пишите что конкретно не получается.

 

[Noya]

множество текста и ничего конкретного.
Непонятно даже delphi это или паскаль.
Пишите что конкретно не получается.

Это ПАскаль!
у меня сейчас в данной программе выходит ошибка разыменование 0 указателя...
а так мне надо сделать чтобы у 1го магазина было несколько товаров. а не 1...

 

[nayke]

Это ПАскаль!
у меня сейчас в данной программе выходит ошибка разыменование 0 указателя...
а так мне надо сделать чтобы у 1го магазина было несколько товаров. а не 1...

С указателями давно не работал - не подскажу, да и смысл их использовать.

Делаете первую record/class

TProduct=record
Caption:string;
price:longint;
//etc
end;

и вторую

TShop=record
Caption:string;
Address:string;
Products: array of TProduct;
//etc
end;

вроде это имели ввиду

 

[Noya]

Спасибо за помощь!!!

Все работает, за исключением сортировки...
Procedure Sort(var q:TList); {Процедура отбора по критериям}
var p,n:TList;
c:sv;
z:string[15];
cc:integer;
begin
p:=q;
while p<>nil do {Перебор всего списка}
begin
n:=p;

while n<>nil do
begin {Перебор спика без элементов из 1 цикла}
for i:=1 to n^.info.k do
begin
if p^.info.tov.cena>=n^.info.tov.cena then
begin
cc:=p^.info.tov.cena;
z:=p^.info.tov.ntov;
p^.info.tov.cena:= n^.info.tov.cena;
p^.info.tov.ntov:=n^.info.tov.ntov;
n^.info.tov.cena:=cc;
n^.info.tov.ntov:=z;
{p^.info:=n^.info;
n^.info:=c; }
end;
end;
n:=n^.next; {следующий элемент 2 цикла}
end;
p:=p^.next; {следующий элемент 1 цикла}
end;

clrscr;
ListPrint(q);

end;


Procedure Sort2(var L:TList); {Процедура сортировки по критериям}
var p,n:TList;

krit:integer;
c:sv;
it:string;
begin
p:=nil;

n:=l;
writeln('naz tovara dli poiska'); readln(it);
while n<>nil do
begin
for i:=1 to n^.info.k do
begin
if n^.info.tov.ntov=it then begin c:=n^.info; addlast(p,c);end;
end;
n:=n^.next;
end;
listprint(p);readln;

sort(p);
end;

НАДО
Результатом поиска является отсортированный в порядке возрастания стоимости искомого товара список магазинов.