program m1; Uses CRT; Type PData = ^TData; TData = record names:array[1..3] of string[15]; {Фамилия, имя, отчество} marks:array[1..4] of integer; {3 оценки} bal:byte; {Дополнительный балл} SB:real; {Средний балл} next:PData; end; {--------------------------------------------------------------------------} procedure hello; begin WriteLn(' ************************************************************ '); WriteLn(' * Программа определения проходного балла на заданную * '); WriteLn(' * специальность по результатам вступительных экзаменов * '); WriteLn(' * и формирования списка студентов, * '); WriteLn(' * чей средний балл выше или равен заданному,упорядочивает * '); WriteLn(' * их по фамилиям и размещает в типизированный файл. * '); WriteLn(' ************************************************************ '); WriteLn; end; {--------------------------------------------------------------------------} procedure vvod(var f:text;var Rec:TData); var s:real; {Сумма 3 оценок} i, k, p:integer; {Позиция в строке ввода} error:integer; {код ошибки при преобраз. строки в число} st:string; bals:string;{Строки,содерж bal} Smarks:array[1..4] of string; Begin { Write('Введите фамилию, имя и отчество: '); } s:=0; readln(f,st); for k:=1 to 3 do begin p:=pos(' ',st); rec.names[k]:=copy(st,1,p-1); delete(st,1,p); end; for i:=1 to 4 do begin { От 1ой до 4ой оценки} p:=pos(' ',st); Smarks[i]:=copy(st,1,p-1); {Вырезаем оценку} val(Smarks[i],rec.marks[i],error); {Преобразовываем строку в число} s:=s+rec.marks[i]; {Накапливаем сумму оценок} delete(st,1,p); {Удаляем i оценку из строки} end; bals:=copy(st,1,p-1); val(bals,rec.bal,error); if rec.bal = 0 then rec.sb:=s/3 { Если дополнительного балла нет } else rec.sb:=(s+rec.bal)/4; end;{vvod} {--------------------------------------------------------------------------} procedure add(var head,tail:PData;var Rec:TData); var p:PData; begin new(p); if Head=nil then head:=p else tail^.next:=p; Tail:=p; p^ := rec; { <-- !!! } p^.next:=nil; end;{add} {--------------------------------------------------------------------------} procedure prosmotr(var head:Pdata); var p:pdata; i,v,k:byte; begin WriteLn('Результат: '); P:=Head; While P<>nil do begin for k:=1 to 3 do Write(P^.names[k]:15); for i:=1 to 3 do write(p^.marks[i]:3); writeln(p^.bal:3,' ',p^.SB:4:1); P:=P^.next; end; {while} end;{prosm} Var Head,Tail:PData; f:text; r:TData; {--------------------------------------------------------------------------} Begin{main} clrscr; Hello; head := nil; assign(f,'sot.txt'); reset(f); while not eof(f) do begin vvod(f,r); add(head,tail,r); end; prosmotr(head); readkey; END.