2. Текст программы

program DmKz;

uses crt;

type PElement=^TypeElement;

TypeElement=record

Org:string;

Tel:Integer;

Kon:string;

Adres:string;

Naz:string;

next:PElement;

end;

var

f: file of string;

b:array[1..100] of PElement ;

ptrhead,a:PElement;

ptrcurrent:PElement;

Tel,vb,kol,gr,vl,k,h,i,n:integer;

Org,Naz,Kon,Adres:string;

procedure sozd(Org:string; Tel:integer; Kon,Adres,Naz:string;

var ptrHead, ptrCurrent: PElement);

{Вставка непервого элемента в линейный однонаправленный список}

{справа от элемента, на который указывает ptrCurrent}

var

ptrAddition: PElement; {вспомогательный указатель}

begin

New(ptrAddition);

ptrAddition^.Org:=Org;

ptrAddition^.Tel:=Tel;

ptrAddition^.Kon:= Kon;

ptrAddition^.Adres:= Adres;

ptrAddition^.Naz:= Naz;

if ptrHead = nil then begin {список пуст}

{Создаем первый элемент списка}

ptrAddition^.Next := nil;

ptrHead := ptrAddition;

end else begin {список не пуст}

{вставляем элемент списка справа от элемента,}

{на который указывает ptrCurrent}

ptrAddition^.Next := ptrCurrent^.Next;

ptrCurrent^.Next := ptrAddition;

end;

ptrCurrent := ptrAddition;

end;

procedure print(ptrHead: PElement);

{Просмотр линейного однонаправленного списка}

var

ptrAddition: PElement; {вспомогательный указатель}

begin

ptrAddition := ptrHead;

while ptrAddition <> nil do begin {пока не конец списка}

writeln('| ',ptrAddition^.Org:14, ' | ',ptrAddition^.Tel:14,' | ',ptrAddition^.Kon:7,' | ',ptrAddition^.Adres:10,' | ',ptrAddition^.Naz:12,' |' ); {Вывод значения элемента}

ptrAddition := ptrAddition^.Next;

writeln(' |--------------|--------------|-------|----------|-----------||');

end;

end;

{********************************************************************************}

procedure SortOrg(var ptrHead:PElement); {передаем указатель на голову списка}

var curr:PElement;

i,j,k:integer;

tel2: integer;

Org2,Naz2,Kon2,Adres2:string;

begin

k:=0;

{считаем количество элементов в списке}

curr:=ptrHead;

while(curr<>nil) do

begin

inc(k);

curr:=curr^.next;

end;

for j:=1 to k-1 do

begin

curr:=ptrHead;

for i:=1 to k-j do

begin

if curr^.Org>curr^.next^.Org then

begin

{тут меняем данные в элементах списков}

Org2:=curr^.Org;

curr^.Org:=curr^.next^.Org;

curr^.next^.Org:=Org2;

Tel2:=curr^.Tel;

curr^.Tel:=curr^.next^.Tel;

curr^.next^.Tel:=Tel2;

Kon2:=curr^.Kon;

curr^.Kon:=curr^.next^.Kon;

curr^.next^.Kon:=Kon2;

Adres2:=curr^.Adres;

curr^.Adres:=curr^.next^.Adres;

curr^.next^.Adres:=Adres2;

Naz2:=curr^.Naz;

curr^.Naz:=curr^.next^.Naz;

curr^.next^.Naz:=Naz2;

end;

curr:=curr^.next;

end;

end;

end;

{*****************************************************************}

procedure SortNum(var ptrHead:PElement); {передаём указатель на голову списка}

var curr:PElement;

i,j,k:integer;

tel2: integer;

Org2,Naz2,Kon2,Adres2:string;

begin

k:=0;

{считаем количество элементов в списке}

curr:=ptrHead;

while(curr<>nil) do

begin

inc(k);

curr:=curr^.next;

end;

for j:=1 to k-1 do

begin

curr:=ptrHead;

for i:=1 to k-j do

begin

if curr^.Tel>curr^.next^.Tel then

begin

{тут меняем данные в элементах списков}

Org2:=curr^.Org;

curr^.Org:=curr^.next^.Org;

curr^.next^.Org:=Org2;

Tel2:=curr^.Tel;

curr^.Tel:=curr^.next^.Tel;

curr^.next^.Tel:=Tel2;

Kon2:=curr^.Kon;

curr^.Kon:=curr^.next^.Kon;

curr^.next^.Kon:=Kon2;

Adres2:=curr^.Adres;

curr^.Adres:=curr^.next^.Adres;

curr^.next^.Adres:=Adres2;

Naz2:=curr^.Naz;

curr^.Naz:=curr^.next^.Naz;

curr^.next^.Naz:=Naz2;

end;

curr:=curr^.next;

end;

end;

end;

{*****************************************************************}

procedure VblvdKont(var ptrHead:PElement); {передаём указатель на голову списка}

var curr,ptrAddition:PElement;

i,j,k:integer;

tel2: integer;

Org2,Naz2,Kon2,Adres2:string;

begin

k:=0;

curr:=ptrHead;

while(curr<>nil) do

begin

inc(k);

curr:=curr^.next;

end;

for j:=1 to k-1 do

begin

curr:=ptrHead;

for i:=1 to k-j do

begin

if curr^.Tel>curr^.next^.Tel then

begin

Org2:=curr^.Org;

curr^.Org:=curr^.next^.Org;

curr^.next^.Org:=Org2;

Tel2:=curr^.Tel;

curr^.Tel:=curr^.next^.Tel;

curr^.next^.Tel:=Tel2;

Kon2:=curr^.Kon;

curr^.Kon:=curr^.next^.Kon;

curr^.next^.Kon:=Kon2;

Adres2:=curr^.Adres;

curr^.Adres:=curr^.next^.Adres;

curr^.next^.Adres:=Adres2;

Naz2:=curr^.Naz;

curr^.Naz:=curr^.next^.Naz;

curr^.next^.Naz:=Naz2;

end;

curr:=curr^.next;

end;

end;

begin

ptrAddition := ptrHead;

while ptrAddition <> nil do begin

if ptrAddition^.Kon<> ' ' then

Begin

writeln('| ',ptrAddition^.Org:14, ' | ',ptrAddition^.Tel:14,' | ',ptrAddition^.Kon:7,' | ',ptrAddition^.Adres:10,' | ',ptrAddition^.Naz:12,' |' );

ptrAddition := ptrAddition^.Next;

writeln(' |--------------|--------------|-------|----------|-----------||');

End

Else

ptrAddition := ptrAddition^.Next;

end;

end;

end;

{*****************************************************************}

procedure PoiskNaz(var ptrHead:PElement);

var curr:PElement;

i,j,k:integer;

p,m:string;

begin

Writeln(‘ Введите назначение для поиска');

Readln(p);

Writeln('Введите маску адреса для поиска ');

Readln(m);

j:=0;

k:=0;

i:=1;

curr:=ptrHead;

while (curr<>nil) do

begin

if curr^.Naz = p then

Begin

while (curr^.Adres[i]<>'.') do

Begin

if m[i] <> '*' then

Begin

k:=k+1;

if curr^.Adres[i] = m[i] then

Begin

j:=j+1;

i:=i+1

End

Else

i:=i+1;

End

Else

i:=i+1;

End;

If k=j then

Begin

writeln('| ',curr^.Org:14, ' | ',curr^.Tel:14,' | ',curr^.Kon:7,' | ',curr^.Adres:10,' | ',curr^.Naz:12,' |' );

curr:=curr^.next;

End

Else curr:=curr^.next;

End

Else

Begin

curr:=curr^.next;

End;

End;

End ;

{******************************************************************}

procedure KolNaz(var ptrHead:PElement);

var curr:PElement;

i:integer;

tel2: integer;

p,Org2,Naz2,Kon2,Adres2:string;

begin

Writeln(‘ Введите назначения для поиска ');

Readln(p);

i:=0;

curr:=ptrHead;

while(curr<>nil) do

begin

if curr^.Naz = p then

Begin

i:=i+1;

curr:=curr^.next;

End

Else curr:=curr^.next;

end;

Writeln('Количество организаций ',i);

End;

{******************************************************************}

function del(Org: string;

var ptrHead, ptrCurrent: PElement): boolean;

var

x:string;

ptrAddition:PElement;

begin

writeln('Введите название организации');

readln(x);

if (ptrHead <> nil)then begin

ptrAddition := ptrHead;

while (ptrAddition <> nil) and (ptrAddition^.Org <> x) do

ptrAddition := ptrAddition^.Next;

if ptrAddition <> nil then begin

del := true;

ptrCurrent := ptrAddition;

end else begin

del := false;

end;

end else begin

del:=false;

end;

del := true;

begin

if ptrCurrent <> nil then begin

if ptrCurrent = ptrHead then

ptrHead := ptrHead^.Next;

dispose(ptrCurrent);

ptrCurrent := ptrHead;

end else begin

ptrAddition := ptrHead;

while ptrAddition^.Next <> ptrCurrent do

ptrAddition := ptrAddition^.Next;

ptrAddition^.Next := ptrCurrent^.Next;

dispose(ptrCurrent);

ptrCurrent := ptrAddition;

end;

end;

end;

writeln('Элемент удалён');

readln();

end;

{******************************************************************}

function Edit(Org:string;

var ptrHead,ptrCurrent: PElement):boolean;

var

Edit:boolean;

x:string;

ptrAddition:PElement;

begin

writeln('Введите организацию для редактирования');

readln(x);

if (ptrHead <> nil)then begin

ptrAddition := ptrHead;

while (ptrAddition <> nil) and (ptrAddition^.Org <> x) do

ptrAddition := ptrAddition^.Next;

if ptrAddition <> nil then begin

Edit := true;

ptrCurrent := ptrAddition;

end else begin

Edit := false;

end;

end else begin

Edit:=false;

end;

if Edit = true then begin

if ptrCurrent <> nil then begin

if ptrCurrent = ptrHead then begin

ptrHead := ptrHead^.Next;

dispose(ptrCurrent);

ptrCurrent := ptrHead;

end else begin

ptrAddition := ptrHead;

while ptrAddition^.Next <> ptrCurrent do

ptrAddition := ptrAddition^.Next;

{непосредственное удаление элемента}

ptrAddition^.Next := ptrCurrent^.Next;

dispose(ptrCurrent);

ptrCurrent := ptrAddition;

end;

end;

end;

end;

{************************************}

begin

clrscr;

ptrhead:=nil;

ptrcurrent := nil;

repeat

clrscr;

writeln(' ___________________________________________ ');

writeln(' | !---Телефонный Справочник ---! |');

writeln(' | 1-Новая база данных |');

writeln(' | 2-Просмотр базы данных |');

writeln(' | 3-Дозапись базы данных |');

writeln(' | 4-Просмотр базы данных по организациям |');

writeln(' | 5- Просмотр базы данных по номерам |');

writeln(' | 6- Просмотр базы данных по назначениям |');

writeln(' | и маске адреса |');

writeln(' | 7- Просмотр базы данных по телефонам |');

writeln(' | при наличии информации в графе контакты |');

writeln(' | 8-Количество организаций по назначениям |');

writeln(' | 9-Удаление элемента из списка |');

writeln(' | 10-Редактирование элемента из списка |');

writeln(' |___________________________________________|');

readln(vb);

case vb of

1: begin

assign (f, 'c:\file.txt');

rewrite (f);

writeln('Введите кол-во элементов');

readln(n);

for i:=1 to n do begin

write (' Введите название ',i,'-ой организации '); read (Org);

write (' Введите номер телефона ',i,'-ой организации '); read (Tel);

write (' Введите Контакт ',i,'-ой организации '); read (Kon);

write (' Введите Адрес ',i,'-ой организации '); read (Adres);

write (' Введите Назначение ',i,'-ой организации '); read (Naz);

sozd(Org,Tel,Kon,Adres,Naz,ptrhead,ptrcurrent);

write (f, Org);

end;

close (f);

end;

2: begin

writeln(' |-----------------------------------------------------------------------------------|');

writeln(' | Телефонный справочник |');

writeln(' |--------------|------------------------|-----------|----------|-----------------||');

writeln(' |Название |Номер телефона|Контакт|Адрес | Назначение||');

writeln(' |--------------|------------------------|-----------|----------|-----------------||');

print(ptrhead);

writeln('Если вы просмотрели список нажмите любую клавишу');

readln;

end;

3: begin

assign (f, 'c:\file.txt');

rewrite (f);

writeln('Введите кол-во элементов');

readln(n);

for i:=1 to n do begin

write (' Введите название ',i,'-ой организации '); read (Org);

write (' Введите номер телефона ',i,'-ой организации '); read (Tel);

write (' Введите Контакт ',i,'-ой организации '); read (Kon);

write (' Введите Адрес ',i,'-ой организации '); read (Adres);

write (' Введите Назначение ',i,'-ой организации '); read (Naz);

sozd(Org,Tel,Kon,Adres,Naz,ptrhead,ptrcurrent);

write (f, Org);

end;

end;

4:begin

SortOrg(ptrHead);

writeln(' |-----------------------------------------------------------------------------------|');

writeln(' | Телефонный справочник |');

writeln(' |--------------|------------------------|-----------|----------|-----------------||');

writeln(' |Название |Номер телефона|Контакт|Адрес | Назначение||');

writeln(' |--------------|------------------------|-----------|----------|-----------------||');

print(ptrhead);

writeln('Если вы просмотрели список нажмите любую клавишу');

readln

end;

5:begin

SortNum(ptrHead);

writeln(' |-----------------------------------------------------------------------------------|');

writeln(' | Телефонный справочник |');

writeln(' |--------------|------------------------|-----------|----------|-----------------||');

writeln(' |Название |Номер телефона|Контакт|Адрес | Назначение||');

writeln(' |--------------|------------------------|-----------|----------|-----------------||');

print(ptrhead);

writeln('Если вы просмотрели список нажмите любую клавишу');

readln

end;

6: begin

PoiskNaz(ptrHead);

readln

end;

7: begin

VblvdKont(ptrHead);

readln

end;

8: begin

KolNaz(ptrHead);

readln

end;

9: begin

del(Org,ptrHead,ptrcurrent);

end;

10: begin

Edit(Org,ptrHead,ptrcurrent);

write (' Введите название ',i,'-ой организации '); read (Org);

write (' Введите номер телефона ',i,'-ой организации '); read (Tel);

write (' Введите Контакт ',i,'-ой организации '); read (Kon);

write (' Введите Адрес ',i,'-ой организации '); read (Adres);

write (' Введите Назначение ',i,'-ой организации '); read (Naz);

sozd(Org,Tel,Kon,Adres,Naz,ptrhead,ptrcurrent);

end;

end;

until(vb=11)

end.