Паскаль, программа, помощь в корректировке

[julia.avdes]

Паскаль, программа, помощь в корректировке

Здравствуйте!
Задание:
Сводная ведомость результатов экзаменационной сессии студенческой группы находится в файле на диске и для каждого студента содержит фамилию, инициалы и оценки по пяти предметам. Количество студентов в группе не превышает 20 человек.
Составить программу, с помощью которой можно корректировать и дополнять список и получать:
• список студентов;
• список студентов, сдавших экзамены только на «5»;
• список студентов, имеющих тройки;
• список студентов, имеющих двойки.
При этом студент, имеющий более чем одну двойку, исключается из списка.


есть наработки:

Вариант 1:

Program curs;
uses crt;
Type
student = record
n : byte ;
f,ini: string[10] ;
bal : array [1..5] of byte;
end;
Var spisok : student ;
sp : file;
a: integer;

procedure vvod;
var i,j:byte;
f:text;
begin
assign (sp,'Vedom.txt');
rewrite ( sp);
with spisok do
For i:=1 to 2 do
begin
n:=i;
write(sp);
writeln (' Введите фамилию - ' ); readln (f);
writeln (' Введите инициалы - ' ); readln (ini);
writeln (' Введите 5 оценкок ' );
For j:= 1 to 5 do readln ( bal [j] );
write (sp , spisok);
end;
close (sp);
end;

procedure print;
var j : byte;
begin
reset ( sp);
writeln (' Список студентов: ');
while not eof (sp) do
with spisok do
begin
Read (sp, spisok);
writeln (f,' ',ini);
For j:= 1 to 5 do write (' ', bal [j],' ' );
writeln ;
end;
readln;
close (sp) ;
end;

procedure otl;
var j : byte;k:=0;
begin
reset ( sp);
writeln (' Cписок студентов, сдавших экзамены только на «5» ');
while not eof (sp) do
with spisok do
begin
Read (sp, spisok);
For j:= 1 to 5 do
if bal[j]=5 then k:=k+1;
if k=5 then write ( f, ' ' ,ini );
k:=0;
writeln ;
end;
readln;
close (sp) ;
end;

procedure ydov;
var j : byte;begin
reset ( sp);
writeln (' Cписок студентов,имеющих тройки ');
while not eof (sp) do
with spisok do
begin
Read (sp, spisok);
For j:= 1 to 5 do begin
if bal[j]=3 then begin
write (f,' ' ,ini );
break;
end;
end;
writeln ;
end;
readln;
close (sp) ;
end;

procedure dva;
var j : byte;
begin
reset ( sp);
writeln (' Cписок студентов,имеющих двойки');
while not eof (sp) do
with spisok do
begin
Read (sp, spisok);
For j:= 1 to 5 do begin
if bal[j]=2 then begin
write (f,' ' ,ini );
break;
end;

writeln ;
end;
readln;
close (sp) ;
end;end;



begin
assign (sp,'Vedom.txt');
repeat
writeln('_____________________________________________________________________________');
writeln('=============================================================================');
writeln('_____Внести фамилии, инициалы и оценки студентов в базу________________/1 ___');
writeln('_____Посмотреть список всех студентов__________________________________/2____');
writeln('_____Посмотреть список студентов, сдавших экзамены только на «5»_______/3____');
writeln('_____Посмотреть список студентов,имеющих тройки________________________/4____');
writeln('_____Посмотреть список студентов,имеющих двойки________________________/5____');
writeln('_____Посмотреть список студентов, сдавших экзамены без 2_______________/6____');
writeln('=============================================================================');
writeln('_____________________________________________________________________________');
read (a);
case a of
1: Vvod;
2: print;
3: otl;
4: ydov;
5: dva;

end;
until a=0;
end.


проблема в записи в файл, получаю не верные символы. Нужно исправить, чтобы в сохраненном файле показывалось список группы и оценки.


Вариант 2:

uses crt;
const
n=3;
Type
Tstudent=record (*Тип студент*)
LastName:string[10];
FIO:string[10];
Mark:array[1..5] of byte;
end;
VAr
Student:array[1..n] of Tstudent;(*Массив з 20 студентами*)
I,j:integer;
F:text;
Ch:char;

Procedure Refresh; (*Процедура ввода информации о студентах*)
var I,j:integer;
begin
for i:=1 to n do
Begin
Writeln;
Write('Фамилия: ');
Readln(student.LastName);
Write('Ф.И.О: ');
Readln(student.FIO);
for j:=1 to 5 do
Begin
Write('Оценка: ');
Readln(student.mark[j]);
end;
end;
end;

Procedure Write_File;(*Запись информации в файл о студентах*)
var I,j:integer;
begin
Assign(f,'q.txt');
Rewrite(f);
for i:=1 to n do
Begin
Writeln(f,student.LastName);
Writeln(f,Student.FIO);
for j:=1 to 5 do
Writeln(f,student.mark[j]);
end;
Close(f);
end;
Procedure Read_File;(*Чтение информации из файла о студентах*)
var I,j:integer;
Begin
Assign(f,'q.txt');
Reset(f);
i:=0;
Repeat
inc(i);
Readln(f,student.LastName);
Readln(f,Student.FIO);
for j:=1 to 5 do
Readln(f,student.mark[j]);
until (eof(f))or(i>=n);
Close(f);
end;


записывает в файл, но не могу додумать как составить процедуру вывода всех студентов, студентов отличников итд.

Буду благодарна любой помощи, даже маленькой подсказки.

 

[poiu]

я весь код не читал конечно (не люблю разбираться в чужом коде), нго могу предложить след. вариант. раз число студиков не велико, можно забить все это дело в массив. mas: array[1..20] of student. а в студент дописать поле средний балл (по которому и найдутся отличники), а количество записей массива - количество студиков.
надеюсь доходчиво высказал теорию.

 

[Vladimir_S]

Всё, чем могу помочь - предложить свой, полностью отлаженный вариант решения задачи:

uses CRT;
Type
 student = record
            f,ini:string[10] ;
            bal:array [1..5] of byte;
           end;
 file_type=file of student;

Var
 sp0,sp1,sp5,sp3,sp2:file_type;
 a:Byte;

procedure Vvod;
var
 i,j,N,Q,k,m:byte;
 C:Char;
 stud:student;
 spisok:Array[1..20] of student;
begin
 {$I-}
 N:=0;
 Q:=1;
 reset(sp0);
 If IOResult=0 then
  begin
   while not EoF(sp0) do
    begin
     Inc(N);
     read(sp0,stud);
     spisok[N]:=stud;
    end;
   close(sp0);
   rewrite(sp0);
   Writeln('New list        - 1');
   Writeln('Add students    - 2');
   Writeln('Delete students - 3');
   Readln(Q);
   if Q=2 then for i:=1 to N do write(sp0,spisok[i]) else
   if Q=3 then
    begin
     k:=0;
     for i:=1 to N do
      begin
       with spisok[i] do
        begin
         write(f,' ',ini);
         for m:=Length(f)+Length(ini)+2 to 20 do write(' ');
         for j:=1 to 5 do write(bal[j]:4);
        end;
       write(' - delete (Y/N)? ');
       readln(C);
       if (C='N') or (C='n') then write(sp0,spisok[i]) else Inc(k);
      end;
     Dec(N,k);
    end;
  end else
 rewrite(sp0);
 if Q<3 then
  repeat
   Inc(N);
   Writeln('Next student:');
   if N<21 then
    begin
     with stud do
      begin
       write('family - ' ); readln(f);
       write('initials - ' ); readln(ini);
       writeln('5 marks - ' );
       for i:=1 to 4 do read(bal[i]); readln(bal[5]);
      end;
     write (sp0,stud);
     write('Continue? (Y/N) '); Readln(C);
     writeln;
    end;
  until (C='N') or (C='n') or (N=20);
 close(sp0);
 {$I+}
end;

procedure Print(var fff:file_type);
var
 i,j:byte;
 stud:student;
begin
 Reset(fff);
 while not eof(fff) do
  begin
   read(fff,stud);
   with stud do
    begin
     write(f,' ',ini);
     for i:=Length(f)+Length(ini)+2 to 20 do write(' ');
     for j:=1 to 5 do write(bal[j]:4);
     writeln;
    end;
  end;
 Close(fff);
 Readkey;
end;

procedure Otsev;
var
 stud:student;
 i,k:byte;
begin
 reset(sp0);
 rewrite(sp1);
 repeat
  read(sp0,stud);
  with stud do
   begin
    k:=0;
    for i:=1 to 5 do
     if bal[i]=2 then Inc(k);
    if k<2 then write(sp1,stud);
   end;
 until EoF(sp0);
 Close(sp0);
 Close(sp1);
end;

procedure Udov;
var
 stud:student;
 i,k:byte;
begin
 reset(sp1);
 rewrite(sp3);
 repeat
  read(sp1,stud);
  with stud do
   begin
    k:=0;
    for i:=1 to 5 do
     if bal[i]=3 then Inc(k);
    if k>0 then write(sp3,stud);
   end;
 until EoF(sp1);
 Close(sp1);
 Close(sp3);
end;

procedure Otl;
var
 stud:student;
 i,k:byte;
begin
 reset(sp1);
 rewrite(sp5);
 repeat
  read(sp1,stud);
  with stud do
   begin
    k:=0;
    for i:=1 to 5 do
     if bal[i]=5 then Inc(k);
    if k=5 then write(sp5,stud);
   end;
 until EoF(sp1);
 Close(sp1);
 Close(sp5);
end;

procedure Dva;
var
 stud:student;
 i,k:byte;
begin
 reset(sp1);
 rewrite(sp2);
 repeat
  read(sp1,stud);
  with stud do
   begin
    k:=0;
    for i:=1 to 5 do
     if bal[i]=2 then Inc(k);
    if k>0 then write(sp2,stud);
   end;
 until EoF(sp1);
 Close(sp1);
 Close(sp2);
end;


begin
 assign(sp0,'0');
 assign(sp1,'1');
 assign(sp2,'2');
 assign(sp3,'3');
 assign(sp5,'5');
 repeat
  Clrscr;
  writeln('Edit the list            - 1');
  writeln('Print the initial list   - 2');
  writeln('Print the corrected list - 3');
  writeln('Students having "2"      - 4');
  writeln('Students having "3"      - 5');
  writeln('Students having only "5" - 6');
  writeln('Quit the program         - 7');
  Readln(a);
  ClrScr;
  Case a of
   1: begin
       Vvod;
       Otsev;
      end;
   2: begin
       Writeln('Initial list:');
       Print(sp0);
      end;
   3: begin
       Writeln('List after the abandonment of weak students:');
       Print(sp1);
      end;
   4: begin
       Writeln('List of students having one "2":');
       Dva;
       Print(sp2);
      end;
   5: begin
       Writeln('List of students having "3":');
       Udov;
       Print(sp3);
      end;
   6: begin
       Writeln('List of students having only "5":');
       Otl;
       Print(sp5);
      end;
  end;
 until a=7;
end.