Это только часть моей контрольной работы. Выполненная по завышенным требованиям. Обязана работать безотказно.
Для работы необходим модуль и файл с исходными данными, иначе программа вам ничего не отобразит (см. архив).
Содержание файла KR_2K_2Z.PAS:
program kr_2k_2z; uses crt,JaRcom2; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Nachalo_"kr_2k_2z.pas"*) Type date=record d,m,g:integer; end; paper=record fio: string[30]; adres:record yl:string[20]; dom,kv:word; end; name: string[30]; dn:date; dk:date; ye:real; end; Label 1,2,3,4,5; var a:array[1..99]of paper; z:paper; nazva:string[30]; st:string; i,j,n,b,s,ss,gp,month,god:integer; t:char; f,p:file of paper; fv:text; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Procedura_key*) procedure key; Begin TextColor(12);writeln('press any key for continuation');TextColor(15);readkey; end; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Procedura_Proverki_datu*) procedure ProvDat(ii:string;var s,d,m,g:integer); var s1,s2,s3,j1,j2,j3:integer; ss,i1,i2,i3:string; Begin s1:=0;s2:=0;s3:=1;ss:='';s:=1; while (Length(ii)>s1) do begin s1:=s1+1; if(ii[s1]<>#32{' '})then begin s2:=s2+1; Insert(ii[s1],ss,s2); end else begin s2:=0; s3:=s3+1; ss:=''; end; case s3 of 1:i1:=ss; 2:i2:=ss; 3:i3:=ss; end; end; val(i1,d,j1);val(i2,m,j2);val(i3,g,j3);if(j1<>0)or(j2<>0)or(j3<>0)then s:=0 else i1:='';i2:='';i3:=''; if(d>=1)and(d<=31)and(m>=1)and(m<=12)and(g>=1)and(g<=9999)then CASE M OF 4,6,9,11:if(d=31)then s:=0; 2:if(D>=30)then s:=0 else if(D=29)and(G mod 4<>0)then s:=0; end else s:=0; end; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Procedura_Vvoda_Dannux*) procedure VvodDannux; var ii:string; jj:integer; Label 1,2,3,4,5; Begin Repeat i:=i+1; with a[i] do Begin write ('Введите фамилию подписчика:_'); readln(fio); writeln('Введите его адрес'); write(' Улица:_ ');readln(adres.yl); 1:write(' Дом: ');readln(ii);val(ii,adres.dom,jj); if(jj<>0)then begin error;goto 1;end; 2:write(' Квартира: ');readln(ii);val(ii,adres.kv,jj); if(jj<>0)then begin error;goto 2;end; write('Введите название журнала(газеты):_'); readln(name); 3:write('Введите дату начала подписки (дд мм гггг): '); readln(ii); ProvDat(ii,b,dn.d,dn.m,dn.g); if(b=0)then begin error; goto 3; end; 4:write('Введите дату конца подписки (дд мм гггг): '); readln(ii); ProvDat(ii,b,dk.d,dk.m,dk.g); if(b=0)then begin error; goto 4; end; if (dk.g<dn.g)then begin error;goto 4;end else if(dk.g=dn.g)and(dk.m<dn.m)then begin error;goto 4;end else if(dk.m=dn.m)and(dk.d<dn.d)then begin error;goto 4;end; 5:write('Введите стоимость подписки: ');readln(ii);val(ii,ye,jj);if(jj<>0)then begin error;goto 5;end; end; writeln('Нажмите Esc для завершения или любую другую клавишу для продолжения'); until ReadKey=#27; n:=i; end; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Procedura_Kopurovaniya*) procedure kopirka(u:word); begin reset(f); i:=0; if u=1 then while not(eof(f)) do begin i:=i+1;read(f,a[i]); end else begin rewrite(p);while not(eof(f)) do begin read(f,z);i:=i+1;write(p,z);end;close(p);end; close(f); n:=i; end; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Procedura_vuvod_na_ekran*) procedure vuvod(u:word); begin reset(p); i:=0; samsung(10,1,0); if u=1 then begin writeln ('+-----------------------------------------------------------------------------+'); writeln(fv,'+-----------------------------------------------------------------------------+'); writeln ('|№ | Фамилия|Адрес подписчика| Название| Дата нач. / кон.подп. |Стоимость|'); writeln(fv,'|№ | Фамилия|Адрес подписчика| Название| Дата нач. / кон.подп. |Стоимость|'); writeln ('+-----------------------------------------------------------------------------+'); writeln(fv,'+-----------------------------------------------------------------------------+'); while not(eof(p)) do begin read(p,z); i:=i+1; if(i mod 11=0)then readkey; write ('|',i:2,'|',z.fio:11,'|',z.adres.yl:10,z.adres.dom:3,z.adres.kv:3,'|',z.name:11,'| '); write (fv,'|',i:2,'|',z.fio:11,'|',z.adres.yl:10,z.adres.dom:3,z.adres.kv:3,'|',z.name:11,'| '); writeln (z.dn.d:2,' ',z.dn.m:2,' ',z.dn.g:4,'/',z.dk.d:2,' ',z.dk.m:2,' ',z.dk.g:4,' |',z.ye:9:3,'|'); writeln(fv,z.dn.d:2,' ',z.dn.m:2,' ',z.dn.g:4,'/',z.dk.d:2,' ',z.dk.m:2,' ',z.dk.g:4,' |',z.ye:9:3,'|'); writeln ('+-----------------------------------------------------------------------------+'); writeln(fv,'+-----------------------------------------------------------------------------+'); end; end else begin writeln ('+----------------------------------------------------------------+'); writeln(fv,'+----------------------------------------------------------------+'); writeln ('| № | Раздел | Данные |'); writeln(fv,'| № | Раздел | Данные |'); writeln ('+----------------------------------------------------------------+'); writeln(fv,'+----------------------------------------------------------------+'); while not(eof(p)) do begin read(p,z); i:=i+1; writeln ('|',i:2,' |',' Фамилия подписчика ','| ',z.fio:30,' |'); writeln(fv,'|',i:2,' |',' Фамилия подписчика ','| ',z.fio:30,' |'); writeln ('| |',' Адрес подписчика ','| ',z.adres.yl:20,z.adres.dom:5,z.adres.kv:5,' |'); writeln(fv,'| |',' Адрес подписчика ','| ',z.adres.yl:20,z.adres.dom:5,z.adres.kv:5,' |'); writeln ('| |',' Название журнала(газеты) ','| ',z.name:30,' |'); writeln(fv,'| |',' Название журнала(газеты) ','| ',z.name:30,' |'); write ('| |',' Дата начала/конца подписки','| ','':7,z.dn.d:2,' ',z.dn.m:2,' ',z.dn.g:4,' / '); write (fv,'| |',' Дата начала/конца подписки','| ','':7,z.dn.d:2,' ',z.dn.m:2,' ',z.dn.g:4,' / '); writeln (z.dk.d:2,' ',z.dk.m:2,' ',z.dk.g:4,' |'); writeln(fv,z.dk.d:2,' ',z.dk.m:2,' ',z.dk.g:4,' |'); writeln ('| |',' Стоимость подписки ','| ',z.ye:30:3,' |'); writeln(fv,'| |',' Стоимость подписки ','| ',z.ye:30:3,' |'); writeln ('+----------------------------------------------------------------+'); writeln(fv,'+----------------------------------------------------------------+'); end; end; close(p); n:=i; samsung(15,1,0); end; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Procedura_SortName*) procedure SortName; Begin kopirka(1); for i:=1 to n-1 do for j:=i+1 to n do if(a[i].name>a[j].name)then begin z:=a[i]; a[i]:=a[j]; a[j]:=z; end; i:=1; while i<=n do begin nazva:=a[i].name; j:=0; while(i<=n)and(nazva=a[i].name)do begin j:=j+1; i:=i+1; end; end;rewrite(p);for i:=1 to n do write(p,a[i]); close(p); end; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*OSNOVNAYA_PROGRAMA*) begin assign(f,'file_p.txt');assign(p,'temp.txt'); assign(fv,'paperJaR.txt'); samsung(14,1,1);{TextColor,TextBackground,clrscr} head(2); writeln('':3,'Tipizirovanue failu'); rewrite(fv); {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*MENYU_1*) 1:samsung(11,1,0); writeln('1 - Обновить и(или) просмотреть файл данных'); writeln('2 - Дозаписать'); writeln('3 - Редоктировать запись'); writeln('4 - Удаление записи'); writeln('5 - Далее (Задание 18 варианта)'); samsung(15,1,0); case ReadKey of '1':begin write('Xотите обновить файл данных (Y/N)? '); readln(t); if (t='Y')or(t='y') then begin i:=0; VvodDannux; rewrite(f);for i:=1 to n do write(f,a[i]);close(f); end; kopirka(0); vuvod(1); end; '2':begin kopirka(1); VvodDannux; rewrite(f);for i:=1 to n do write(f,a[i]);close(f); kopirka(0); vuvod(1); writeln(fv,' Была добавлена новая запись.'); end; '3':begin kopirka(0); vuvod(1); repeat write('Введите номер записи для редактирования: '); readln(st); s:=0; val(st,s,j); if(j=0)then begin reset(f); if(s<=0)or(s>FileSize(f))then begin error; j:=1; end; close(f); end else begin error; j:=1; end; until j<>1; writeln('+-----------------------------------------------------------------------------+'); writeln('|№ | Фамилия|Адрес подписчика| Название| Дата нач. | кон.подп. |Стоимость|'); writeln('|-----------------------------------------------------------------------------|'); writeln('| | 1 | 2 | 3 | 4 | 5 | 6 |'); writeln('+-----------------------------------------------------------------------------+'); repeat write('Какое поле вы хотите изменить?: '); readln(st); ss:=0; val(st,ss,j); if(j<>0)or((ss<=0)or(ss>6))then begin error; j:=1; end; until j<>1; kopirka(1);write(' Введите новое значение '); with a[s] do begin case ss of 1:begin write('фамилии:_'); readln(fio); end; 2:begin write('адреса: улица_');readln(adres.yl); repeat write(' дом_'); readln(st); val(st,adres.dom,j); if(j<>0)then error; until j<>1; repeat write(' квартира_'); readln(st); val(st,adres.kv,j); if(j<>0)then error; until j<>1; end; 3:begin write('названия:_'); readln(name); end; 4:begin 2:write('даты начала подписки (дд мм гггг): '); readln(st); ProvDat(st,b,dn.d,dn.m,dn.g); if(b=0)then begin error; goto 2; end; end; 5:begin 3:write('даты конца подписки (дд мм гггг): '); readln(st); ProvDat(st,b,dk.d,dk.m,dk.g); if(b=0)then begin error; goto 3; end; end; 6:begin repeat write('стоимости: '); readln(st); val(st,ye,j); if(j<>0)then error; until j<>1; end; end; writeln(' Изменения успешно сохранены.'); writeln(fv,' Запись ',s,' была изменена.'); rewrite(f); for i:=1 to n do write(f,a[i]); end; close(f); end; '4':begin kopirka(0); vuvod(1); repeat write('Какой номер записи вы хотите удалить?: '); readln(st); val(st,s,j); if(j<>0)then error; reset(f); if(s<=0)or(s>FileSize(f))then begin error; j:=1; end; close(f); until j<>1; kopirka(1); rewrite(f); for i:=1 to n do if i<>s then write(f,a[i]); close(f); writeln(fv,' Удалена запись номер ',s); end; '5':begin writeln; goto 4; end; else begin error; GoTo 1; end; end; key; GoTo 1; {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*MENYU_2*) 4:samsung(11,1,0); writeln('1 - Определить сколько журналов(газет) нужно заказать в указанном месяце'); writeln('2 - Определить наименование самого популярного журнала(газеты)'); writeln('3 - Вывод значений с сортировкой по дню даты конца подписки'); writeln('4 - EXIT'); TextColor(14); case ReadKey of '1':Begin{сколько журналов(газет) нужно заказать в указанном месяце} TextColor(15); writeln(' Список журналов(газет) использующихся в программе: '); SortName; write(' ',a[1].name); i:=2; if(n>1)then while i<=n do if(a[i-1].name<>a[i].name)then begin write('':3,a[i].name); i:=i+1; end else i:=i+1; writeln; write(' Введите название журнала(газеты): '); readln(nazva); repeat write(' Введите месяц: '); readln(st); val(st,month,j); if(j<>0)then error; until j<>1; repeat write(' Введите год: '); readln(st); val(st,god,j); if(j<>0)then error; until j<>1; kopirka(1); s:=0; for i:=1 to n do with a[i] do begin if (nazva=name) then begin if (god=dn.g) and (god=dk.g) and (month>=dn.m) and (month<=dk.m) then s:=s+1; if (god>dn.g) and (god<dk.g) then s:=s+1; if (god=dn.g) and (god<dk.g) and (month>=dn.m) then s:=s+1; if (god>dn.g) and (god=dk.g) and (month<=dk.m) then s:=s+1; end; end; TextColor(14); writeln (' Журналов(газет) "',nazva,'" в ',month,' месяце ',god,' года нужно заказать ',s,' шт.'); writeln(fv,' Журналов(газет) "',nazva,'" в ',month,' месяце ',god,' года нужно заказать ',s,' шт.'); end; '2':Begin{наименование самого популярного журнала(газеты)} kopirka(0); i:=1;gp:=0; reset(f); while not(eof(f)) do begin s:=0; read(f,a[i]); reset(p); while not(eof(p)) do begin read(p,z); if a[i].name=z.name then s:=s+1; if s>gp then begin gp:=s; nazva:=z.name; end; end; close(p); i:=i+1; end; close(f); kopirka(1); for i:=1 to n-1 do begin s:=0; for j:=i+1 to n do if(a[i].name=a[j].name)then s:=s+1; if(s=gp-1)then begin nazva:=a[i].name; writeln (' Самый популярный журнал(газета) называется: ',nazva,' (',gp,').'); writeln(fv,' Самый популярный журнал(газета) называется: ',nazva,' (',gp,').'); end; end; end; '3':Begin(*Вывод значений с сортировкой по дню даты конца подписки*) kopirka(1); for i:=1 to n-1 do for j:=i+1 to n do if a[i].dk.d>a[j].dk.d then Begin z:=a[i]; a[i]:=a[j]; a[j]:=z; end; for i:=1 to n-1 do for j:=i+1 to n do if a[i].dk.m>a[j].dk.m then Begin z:=a[i]; a[i]:=a[j]; a[j]:=z; end; for i:=1 to n-1 do for j:=i+1 to n do if a[i].dk.g>a[j].dk.g then Begin z:=a[i]; a[i]:=a[j]; a[j]:=z; end; rewrite(p); for i:=1 to n do write(p,a[i]); close(p); samsung(14,1,0); writeln(fv,' массив отсортированный по дате конца подписки.'); writeln ('+-----------------------------------------------------------------------------+'); writeln(fv,'+-----------------------------------------------------------------------------+'); writeln ('| № | Фамилия подписчика | Название журнала(газеты)|Дата начала/конца подписки|'); writeln(fv,'| № | Фамилия подписчика | Название журнала(газеты)|Дата начала/конца подписки|'); writeln ('+-----------------------------------------------------------------------------+'); writeln(fv,'+-----------------------------------------------------------------------------+'); reset(p);i:=0; while not(eof(p)) do begin read(p,z); i:=i+1; if(i mod 11=0)then readkey; write ('|',i:2,' |',z.fio:20,'|',z.name:25,'| ',z.dn.d:2,' ',z.dn.m:2,' ',z.dn.g:4,'/ '); write (fv,'|',i:2,' |',z.fio:20,'|',z.name:25,'| ',z.dn.d:2,' ',z.dn.m:2,' ',z.dn.g:4,'/ '); writeln (z.dk.d:2,' ',z.dk.m:2,' ',z.dk.g:4,' |'); writeln(fv,z.dk.d:2,' ',z.dk.m:2,' ',z.dk.g:4,' |'); writeln ('+-----------------------------------------------------------------------------+'); writeln(fv,'+-----------------------------------------------------------------------------+'); end; close(p); end; 's':Begin SortName; vuvod(1); writeln(fv,' Массив отсортированный по названию журнала.'); end; '4':GoTo 5; #27:goto 1; else begin error; GoTo 4; end; end; goto 4; 5:close(fv); {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}(*Konec__"kr_2k_2z.pas"*) samsung(14,1,0); kinec; end.
