Программа, корректировки файла записей, на примере файла по группе студентов.

[S.T.A.L.K.E.R.20]

Я составил половину программы с модулями, и меню, но остальное не получается.
Программа МЕНЮ;

program Menu;
 uses Crt,ss_type,ss_Sozd,ss_Pros,ss_Usp45,ss_DELET;
 var pm:char;    x,y:byte;
begin
 repeat
  ClrScr; TextBackground (2); TextColor(4);
  writeln('МЕНЮ');
  writeln;writeln('  Построить файл    "gruppa.dat"                     - 1');
      writeln('Просмотреть файл                                              - 2');
      writeln('Формировать список успевающих на 4 и 5             - 3');
      writeln('Удалить запись                                                   - 4');
      writeln('Дописать файл                                                    - 5');
      writeln('Упорядочить записи по фамилии студентов             - 6');
      writeln('Упорядочить записи  поубыванию  среднего балла   - 7');
  writeln;writeln(' Выход                                                          - 0');
  x:=whereX;    y:=whereY;
  repeat
   GotoXY(x,y);    ClrEol;
   readln(pm);
  until pm in ['0'..'7'];
  case pm of
   '1': ps_sozd;
   '2': ps_pros;
   '3': ps_usp45;
  end;
 until pm='0';
end.

Модуль создания файла "gruppa.dat":

unit ss_sozd;
 interface
  uses Crt,ss_type;
  procedure ps_sozd;
 implementation
  procedure ps_sozd;
    var  k,r,ks: integer;
  begin
   ClrScr;
   assign (f,'gruppa.dat');   rewrite(f);
   repeat
    ClrScr;
    ks:=1;
    writeln;  writeln('Введите Фамилию и 8 оценок');
    write(' Фамилия  Студента :');   readln(a.fio);
    for i:=1 to 10 do
     begin
      write('  Оценка',i,'Студента',':');  x:=whereX;  y:=WhereY;
      repeat GotoXY(x,y); ClrEol;  readln(r);  until r in [2..5];
      a.oc[i]:=r;
      ks:=ks+1;
     end;
    write(f,a);
    write('продолжить ввод да-1 нет -0');
    x:=whereX;  y:=WhereY;
    repeat GotoXY(x,y); ClrEol;  readln(k);  until k in [0..1];
   until k=0;
   Close (f);
  end;
end.

Модуль формирования списка хорошистов:

unit ss_usp45;
 interface
  uses Crt,ss_type;
  Procedure ps_usp45;
 implementation
  Procedure ps_usp45;
   var n:byte;    k45,s:integer;
       v:text;    sr:real;
   begin
    ClrScr;
    assign (f,'gruppa.dat');   reset(f);
    assign (v,'xorosh.txt');   rewrite(v);
    writeln(v,'      Список хорошистов и отличников       ');
    while not eof(f) do
     begin
      read(f,a);
      k45:=0;     s:=0;
      for i:=1 to 8 do
       begin
        s:=s+a.oc[i];
        if a.oc[i]>3 then  k45:=k45+1;
       end;
      if k45=8 then
       begin  sr:=s/8;
               n:=30-length(a.fio);
               writeln(v,a.fio,' ': n',' средний балл 'sr:5:2);
       end;
     end;
    writeln('Файл создан, нажмите ENTER');  readln;
    Close (f);  Close (v);
   end;
end.

Модуль Просмотра файла:

unit ss_pros;
interface
 uses ss_type,crt;
 procedure ps_pros;
implementation
 procedure ps_pros;
  var t:text; s,k45,k:integer; sr:real; n:byte;
  begin
   clrscr;
   writeln('********************************************************');
   assign (f,'gruppa.dat'); reset(f);
   while not eof(f) do
    begin
     read(f,a);
     n:=25-length(a.fio);
     write(a.fio,' ':n);
     for i:=1 to 8 do write(a.oc[i]:2);
     writeln;
     end;
     write('‚л室 - 0:');
    x:=whereX;  y:=WhereY;
    repeat GotoXY(x,y); ClrEol;  readln(k);  until k=0;
   close(f);
  end;
end.

Модуль описаний:

unit ss_type;
 interface
  Type zap=record
            fio:string[40];
            oc: array [1..8] of integer;
       end;
  var a:zap;           i,x,y:byte;
      f:file of zap;
 implementation
end.

Пытаюсь сделать ,прошу помощи у вас: Осталось удалить запись, дописать файл, упорядочить записи по фамилии студентов, упорядочить записи по убыванию среднего балла.


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[Serge_Bliznykov]

1)
модуль создания у Вас с ошибкой!
почему цикл по i от 1 до 10? Ведь оценок в массиве всего 8 ?

2) как Вы собираетесь задавать, какую из записей в файле удалять?

3) для сортировки (да и для удаления) КРАЙНЕ желательно прочитать записи в массив в памяти... Вы можете ограничить максимально возможное количество обрабатываемых записей, объявить статический массив нужного размера и считать файл в этот массив?

[S.T.A.L.K.E.R.20]

Отвечаю на 1 вопрос, там я допустил ошибку, мне нужно вводить 10 оценок,
отвечаю на 2-ой вопрос, по фамилии ,предполагается что одинаковых не будет,
отвечаю на 3-й вопрос, я знаю что желательно прочитать записи в массив и т.д, но предполагается что записи по одной будут перезаписывается в рабочий файл сверяться с тем который введен для удаления,и если он совпал то удаляться а если нет то поиск идет дальше, после удаления если таковая запись есть то из рабочего файла все перезаписывается обратно, а рабочий файл удаляется.

Доступ к запися наверное осуществить через Seek(F, FileSize(F) );

[Serge_Bliznykov]

Отвечаю на 1 вопрос, там я допустил ошибку, мне нужно вводить 10 оценок,

Тогда я не понимаю, о какой ошибке Вы говорите.
У вас:

unit ss_type;
  Type zap=record
...
            oc: array [1..8] of integer;

unit ss_usp45;
....
     for i:=1 to 8 do

unit ss_pros;
...
     for i:=1 to 8 do write(a.oc[i]:2);

по второму вопросу - тут ясно, проблем нет. Читать по одной записи, сравнивать, если фамилия совпала - эту запись не писать в выходной файл и всё...

по третьему вопросу.
Как раз таки для удаления (тем более для удаления ОДНОЙ записи!) все записи из файла читать не обязательно (можно, но не обязательно!)
А вот для сортировки КРАЙНЕ желательно получить все записи в массив. Т.к. алгоритмы внешней сортировки (это когда файл сортируется частями, которые помещаются в память) не то, чтобы безумно сложны, но всё таки сложнее, чем обычная сортировка в памяти. Поэтому для сортировки я бы рекомендовал завести массив:

var ZapArr : array[1..MaxCount] of zap;

а сортировать его как угодно, хоть тем же методом "пузурёк"!

[S.T.A.L.K.E.R.20]

Да конечно можно завести массив
а тут просто я ошибся, мне нужно вводить 10 оценок а в коде я написал 8.
Код:

unit ss_type;
  Type zap=record
...
            oc: array [1..10] of integer;

unit ss_usp45;
....
     for i:=1 to 10 do

unit ss_pros;
...
     for i:=1 to 10 do write(a.oc[i]:2);

Вот модуль для до записи файла;
вроде работает;

unit ss_dozap;
 interface
  uses Crt,ss_type;
  procedure dozap;
 implementation
  procedure dozap;
    var  k,r,ks: integer;
  Begin
Reset(f);
 Seek (f,filesize(f));
    begin
   ClrScr;
    repeat
    ClrScr;
    ks:=1;
    writeln;  writeln('Введите Фамилию и 10 оценок');
    write(' Фамилия  Студента :');   readln(a.fio);
    for i:=1 to 10 do
     begin
      write('* ',i,': ');  x:=whereX;  y:=WhereY;
      repeat GotoXY(x,y); ClrEol;  readln(r);  until r in [2..5];
      a.oc[i]:=r;
      ks:=ks+1;
     end;
    write(f,a);
    write('Продолжить ввод? *да-1, нет-0:');
    x:=whereX;  y:=WhereY;
    repeat GotoXY(x,y); ClrEol;  readln(k);  until k in [0..1];
   until k=0;
   Close (f);
end;
end;
end.

Модуль для удаления сейчас стараюсь сделать, а вот с сортировкой... помогите пожалуйста с кодом.

[Serge_Bliznykov]

а вот с сортировкой... помогите пожалуйста с кодом.

пока Вы не дадите ответ на принципиальный вопрос - возможно ли задать статический массив с ограниченным количеством студентов (ограничение == размеру массива), мне помочь с кодом будет непросто...

(ведь непонятно, какие алгоритмы сортировку нужно использовать - внутренние или внешние)...

[S.T.A.L.K.E.R.20]

возможно ли задать статический массив с ограниченным количеством студентов (ограничение == размеру массива)

Да, ну только количество студентов не менее 100 .
и там ведь сортировка по фамилии, и по среднему баллу.

[Serge_Bliznykov]

Да, ну только количество студентов не менее 100 .

досовский TurboPascal позволит чуть более 1000 записей (разумеется, для данного типа ZAP )....
так что, думаю, что ограничение в 1000 записей - никого сильно не напряжёт и не ограничит (запаришься 1000 студентов вбивать )

[S.T.A.L.K.E.R.20]

Вот модуль удаления записи ток он не работает,подкорректируйте пожалуйста,

unit ss_DELET;
 interface
  uses Crt,ss_type;
  procedure delet;
 implementation
  procedure delet;
 BEGIN
  If not FileExists('gruppa.dat')
   then NoBase
   else begin
   Reset(F);
    Okno(20,3,60,6,'Udalenie zapisi :');
   Input_fio(fio);   Kart1.fio:='000000';
    While (not EoF(F)) and (fio<>Kart1.fio) do Read(F,Kart1);
  If fio<>Kart1.fio    then Nofio
   else begin
   If EoF(F)
    then Seek(F,FilePos(F)-1)
    else    For i:=FilePos(F) to FileSize(F)-1 do
   begin
    Seek(F,i); Read(F,Kart1);
    Seek(F,i-1); Write(F,Kart1)
 end;

      Truncate(Fv1);       Okno(20,8,60,12,''); Cursor(False); GoToXY(4,2);
      Write('fio',Copy(Tel,1,2),'-', Copy(Tel,3,2),'-', Copy(Tel,5,2), ' удалён из списка'); 
      Pause
      end;
      Close(F);
       end ;
END;

[Serge_Bliznykov]

пример сортировки по фамилии:

uses CRT;

Const
  fiornd = 'пологоровысюдорогофанорусиколамакарабазамашарашалюба';

Const
  MaxCnt = 1000;

  Type zap=record
            fio:string[40];
            oc: array [1..10] of integer;
       end;
   Massive_of_ZAP = array[1..MaxCnt] of zap;


var a : zap;
    i, j, x, y, N : integer;
    MasZap : Massive_of_ZAP;
    f:file of zap;


procedure PrintMas (var Mas : Massive_of_ZAP; CountRecN : integer) ;
var i, j, ln : integer;
begin
  writeln('********************************************************');
  for i:=1 to CountRecN do
    begin
     ln:=25-length(Mas[i].fio);
     write(Mas[i].fio,' ':ln);
     for j:=1 to 10 do write(Mas[i].oc[j]:2);
     writeln;
    end;
end;

procedure SortByFio(var Mas : Massive_of_ZAP; CountRecN : integer);
var i, j : integer;
  msX : zap;
begin
  {сортировка массива методом простых обменов ("пузырька") }
  for i:=1 to CountRecN-1 do
    for j:=i+1 to CountRecN do
      if Mas[i].fio > Mas[j].fio then
        begin
          msX:=Mas[i];
          Mas[i]:=Mas[j];
          Mas[j]:=msX
        end;
end;


function RandomFio : string;
var i, k : integer;
  s : string;
begin
  k:= Random(10)+2; {длина фамилии}
  s := '';
  while Length(s)<k do
    s := s + Copy( fiornd, Random(Length(fiornd))+1, Random(3));
  RandomFio := s
end;

begin
  clrscr;
  Randomize;

  N := 8; {сколько записей будет в массиве - это для отладки...}

  {заполним массив}
  for i:=1 to N do begin
      MasZap[i].fio := RandomFio;
      for j:=1 to 10 do
        MasZap[i].oc[j] := Random(4)+2;
  end;
  
  {выведем исходный массив}
  PrintMas(MasZap, N);


  {отсортируем по фамилии}
  SortByFio(MasZap, N);

  {выведем отсортированный массив}
  WriteLn('Массив после сортировки...');
  PrintMas(MasZap, N);


end.