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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
| program xd;
uses crt;
var
f_in,fotl,zar,ost:Text;
FIO: string;
procedure INFO(key: Integer; pred: String);
label 1,2,3,4,5,6,7,8;
begin
writeln('Исходный файл содержит ошибку (ошибки).');
case key of
1: writeln('Неверно указана Ф.И.О. '+fio+'. Первая буква не является заглавной. Остальные буквы — в нижнем регистре.');
2: writeln('Неверно указана Ф.И.О. '+fio+'. Должны присутствовать только буквы русского алфавита, отсутствовать пробелы и длина не должна превышать 50 символов');
3: writeln('Неверно указано количество предметов в ведомости '+fio+'. Данная величина должна быть числом в диапазоне от 1 до 5000.' );
4: writeln('Неверно указано Наименование предмета '+pred+' в ведомости '+fio+'. Первая буква не является заглавной.');
5: writeln('Неверно указано Наименование предмета '+pred+' в ведомости '+fio+'. Должны присутствовать только буквы русского алфавита и пробелы, длина не должна превышать 60 символов.');
6: writeln('Неверно указана Оценка по предмету '+pred+' в ведомости '+fio+'. Зачету соответствует символ «z» или «Z» без кавычек и пробелов, экзамену — цифра «3″, «4″ или «5″ также указанная без кавычек и пробелов.');
7: writeln('Внимание! Возможна следующая ошибка. Общее количество предметов в ведомости '+fio+' не соответствует указанному.');
8: writeln('Неверно указано Приглашение для '+fio+'. При наличии приглашения следует без кавычек и пробелов указать символ латинского алфавита «Y» или «y», при отсутствии — «N» или «n».');
end;
writeln('Отредактируйте ИСХОДНЫЙ файл и перезапустите программу.');
writeln;
readln;
close(f_in);
close(fotl);
close(zaR);
close(ost);
halt;
end;
procedure open;
var
name: String;
begin
try
assign(f_in,'C:\Users\Ирина\Desktop\Практика\n.txt');
reset(f_in);
except
end;
writeln('Применить к ВЫХОДНЫМ файлам имена по умолчанию (Y/N)?');
readln(name);
if (pos('Y',name)>0) or (pos('y',name)>0) then
try
assign(fotl,'otl.txt'); rewrite(fotl);
assign(zaR,'zar.txt'); rewrite(zaR);
assign(ost,'fost.txt'); rewrite(ost);
except
writeln('Один из файлов отсутствует');
halt;
end
else BEGIN
writeln('Введите имя файла ОТЛИЧНИКОВ');
readln(name);
try
assign(fotl,name); rewrite(fotl);
except
writeln('Файл отсутствует');
halt;
end;
writeln('Введите имя файла с ПРИГЛАШЕНИЯМИ');
readln(name);
try
assign(zaR,name); rewrite(zaR);
except
writeln('Файл отсутствует');
halt;
end;
writeln('Введите имя файла с ОСТАЛЬНИМИ выпускниками');
readln(name);
try
assign(ost,name); rewrite(ost);
except
writeln('Файл отсутствует');
halt;
end;
END;
end;
procedure C_FIO;{ КОНТРОЛЬ ВВОДА ДАННЫХ ФИО }
var
i:Integer;
label 1,2,3,4,5,6,7,8;
begin
2: writeln('Неверно указана Ф.И.О. '+fio+'. Должны присутствовать только буквы русского алфавита, отсутствовать пробелы и длина не должна превышать 50 символов');
if Length(fio)>50 then goto 2;
if Pos(' ',fio)>1 then goto 2;
for i:=1 to length(fio) do
begin
if not ( (UpCase(fio[i])>='А') and (UpCase(fio[i])<='Я') ) then goto 2;
end;
1: writeln('Неверно указана Ф.И.О. '+fio+'. Первая буква не является заглавной. Остальные буквы — в нижнем регистре.');
if not ((fio[1]>='А') and (fio[1]<='Я')) then goto 1;
for i:=2 to Length(fio) do
if fio[i]<='Я' then goto 1;
end;
procedure C_Total (s: String; var i: Integer);{кол-во предметов в ведомости}
var code: Integer;
label 1,2,3,4,5,6,7,8;
begin
try
Val(s,i,code);
3: writeln('Неверно указано количество предметов в ведомости '+fio+'. Данная величина должна быть числом в диапазоне от 1 до 5000.' );
if (code=0) and ((i<1) or (i>5000)) then goto 3;
except
end;
end;
procedure C_Predmet(s: String);{название предмета}
var
i:Integer;
label 1,2,3,4,5,6,7,8;
begin
if Length(s)>60 then INFO(5,s);
for i:=1 to length(s) do
begin
4: writeln('Неверно указано Наименование предмета '+pred+' в ведомости '+fio+'. Первая буква не является заглавной.');
if not (s[i]=' ') then
if not ((UpCase(s[i])>='А') and (UpCase(s[i])<='Я') ) then goto 4;
if not ((s[1]>='А') and (s[1]<='Я')) then goto 4;
end;
end;
{оценка}
procedure C_Number(s,s_oc: String; var key: Integer); {предмет,оценка, число}
var code: Integer;
begin
if (Pos('z',s_oc)>0) or (Pos('Z',s_oc)>0) then
if length(s_oc)=1
then begin key:=0; exit; end {для зачета key=0}
else INFO(6,s);
try
Val(s_oc,key,code);
if (code=0) and ((key<3) or (key>5)) then INFO(6,s);
except
INFO(6,s);
end;
end;
procedure C_YN(s:String);{приглашение + количество предметов по факту}
label 1,2,3,4,5,6,7,8;
begin
7: writeln('Возможна следующая ошибка. Общее количество предметов в ведомости '+fio+' не соответствует указанному.');
8: writeln('Неверно указано Приглашение для '+fio+'. При наличии приглашения следует без кавычек и пробелов указать символ латинского алфавита «Y» или «y», при отсутствии — «N» или «n».');
if ((Pos('Y',s)>0) or (Pos('y',s)>0)) or ((Pos('N',s)>0) or (Pos('n',s)>0)) then
if length(s)=1
then exit
else goto 8
else {не нашли латискую букву} goto 7;
end;
procedure Sort;{ ЧТЕНИЕ ДАННЫХ И ФОРМИРОВАНИЕ СПИСКОВ }
var
kol, c4, c5 , oc: Integer;
s,s_oc: String;
err, otl:Boolean; {учащийся отличник}
begin
{структура файла исходны данных:фамилия,имя,отчество,кол-во предметов,название_предмета,оценка,наличие_приглашения,следующий студент}
writeln;
while not eof(f_in) do
begin
readln(f_in,fio);
C_FIO;
s:=fio;
readln(f_in,fio);
C_FIO;
s:=s+' '+fio;
readln(f_in,fio);
C_FIO;
s:=s+' '+fio;
fio:=s; {теперь ФИО это ФИО}
readln(f_in,s); {read number with control error}
C_Total(s,kol);
otl:=True;
c4:=0;
c5:=0;
err:=False; {у отличника есть и зачеты и экзамены}
while kol>0 do
begin
readln(f_in,s); {predmet}
C_Predmet(s);
readln(f_in,s_oc); {ocenka}
C_Number(s,s_oc,oc);
if otl=False then {если не отличник то анализ оценок не производим — смотрим файл дальше}
begin
dec(kol);
Continue;
end;
if oc=3 then otl:=False
else if oc=4 then inc(c4)
else if oc=5 then inc(c5);
dec(kol);
end; {while kol}
readln(f_in,s); {read Y/N}
C_YN(s);
if (otl=True) and( (c4=0) and (c5=0)) then begin otl:=False ; err:=True; end; {нет ОЦЕНОК только ЗАЧЕТЫ}
if (otl=TRUE) and (c4*100/(c4+c5)>25) then otl:=False; {сброс флага если очень много 4}
if err=False then begin
if otl{ добавление в списки }
then writeln(fotl,fio){//если отличник, записываем в файл отличников}
else writeln(ost,fio);
if s = 'Y' then {//если есть приглашение — то в файл приглашенных за рубеж}
writeln(zaR,fio);
end; {// if err}
end;{//while eof(f1)}
writeln('Выходные данные успешно записаны.');
writeln('Press any key for exit');
readln;
close(f_in);
close(fotl);
close(zaR);
close(ost);
end;
BEGIN
cls;
open;
sort;
END. |
(
