program m1; Uses CRT; Type PData = ^TData; TData = record names:array[1..4] of string[15]; {Фамилия, имя, отчество} marks:array[1..3] 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..3] of string; Begin { Write('Введите фамилию, имя и отчество: '); } s:=0; readln(f,st);{добавление к прочитанной из файла строке пробела} st:=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 3 do begin { От 1ой до 3ой оценки} 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]:14); for i:=1 to 3 do write(p^.marks[i]:3); if p^.bal = 0 then writeln(p^.sb:8:1) else writeln(p^.bal:3,' ',p^.SB:4:1); P:=P^.next; end; {while} end;{prosm} {-------------------------------------------------------------------------} procedure s_faila(var Head:Pdata{;var f:text}); var r:TData; tail:PData; f:text; begin head := nil; assign(f,'sot.txt'); reset(f); while not eof(f) do begin vvod(f,r); add(head,tail,r); end; end; {-------------------------------------------------------------------------} {procedure vnos_po_SB(var head,head2:PData); var tail2,p:PData; begin head2:=nil; p:=head; while p<>nil do begin if p^.sb>=4.5 then add(head2,tail2,p^); p:=p^.next end;{while} {end;} {-------------------------------------------------------------------------} Var Head,Tail,head2,tail2:PData; f:text; r,r2:TData; p:pdata; n:file of TData; Begin{main} clrscr; Hello; s_faila(head); prosmotr(head); {vnos_po_SB(head,head2);} head2:=nil; p:=head; while p<>nil do begin if p^.sb>=4.5 then add(head2,tail2,p^); p:=p^.next end;{while} prosmotr(head2); { head2 := nil; } assign(n,'sot2.dat'); rewrite(n); p:=head2; while p<>nil do begin write(n,p^); p:=p^.next; end;{while} close(n); readkey; END.