lab2 old delphi compatible

program PrjLAB2;  // два параметра – 1) имя типизир. файла, 2) имя текстового файла
{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  UnLab2;

// свой модуль с типом и процедурами для решения задачи

//--------------------главная программа - меню -------------------------
var
  ch: char;
begin
  SetConsoleCP(1251);      // из модуля Windows
  SetConsoleOutputCP(1251);

  repeat
    writeln('--------------------------------------');
    writeln('D - создать новый тип.файл в диалоге; ');
    writeln('N - создать из текстового файла; ');
    writeln('F - поиск и изменение; ');
    writeln('V - просмотр;');
    writeln('E - конец.');
    write('Ваш выбор?'); readln(ch);
    writeln('--------------------------------------');

    ch:= UpCase(ch);  // символ в верхний регистр (латиница)
    case ch of
//--------------------------------------------------------------
//----------первая часть: создание типизированного в диалоге ---
    'D': CreateTypedFile1;  // вызов соответствующей процедуры для выбора D
//----------вторая часть: создание типизированного файла из текстового
    'N': CreateTypedFile2;
//----------третья часть: поиск и редактирование ---------------
    'F': FindIVAN;
//-----------просмотр----------------------------------------------
    'V': ViewFile;
//-----------выход----------------------------------------------
    'E': exit;
//--------------------------------------------------------------
      else
        begin
          writeln('Нет такой команды');
          write('Press ENTER'); readln;
        end;
    end;

  until ch='E';
end.


//MODULE

Unit  UnLab2;   // файл  UnLab2.pas
Interface

Uses
  SysUtils;     // ANSIUpperCase и др. -  смена регистра и обработка исключений

Type  
  TSubj = (Физика, Матан, Линал, Инжграф, Программирование);
  TMark = (Отлично, Хорошо, Удовл, Неуд);
  TGroup = record
    name: string[15];
    subj: TSubj;
    mark: TMark;
    amount: integer;
  end;
    
    

//----------первая часть: создание типизированного файла в диалоге
Procedure CreateTypedFile1();

//----------вторая часть: создание типизированного файла из текстового
Procedure CreateTypedFile2();

//-------------- третья часть: поиск в типизированном файле ----
Procedure FindAndReplace();

//-------------- просмотр типизированного файла ----
Procedure ViewFile();

Function subjToString(subj : TSubj) : string; // преобразование TSubj в строку

Function markToString(mark : TMark) : string; // преобразование TMark в строку


Implementation // -----------реализационная часть-----------------

//----------первая часть: создание типизированного файла в диалоге
Procedure CreateTypedFile1();
var
  Group: TGroup;
  fr: file of TGroup; // типизированный файл - файл записей
  n, kol: integer;
  ch: char;
  FileName:string[80];
begin
  if ParamCount<1 then
  begin
    writeln('Мало параметров '#13#10'Press enter');
    readln;  exit
  end;
  FileName := ParamStr(1);
// или простой диалог или через параметры программы при её вызове ParamStr(1)
// writeln('Введите имя типизированного файла');
// readln(FileName);

  AssignFile(fr, FileName);
  Try  ReWrite(fr);    //  или  {$I-} ReWrite(fr); {$I+} и if IOResult<>0 then <ошибка>
  Except
    writeln('Error: не удалось создать типизированный файл ',FileName);
    write('Press ENTER'); readln;  exit
  end;

  kol:=0;
  repeat
    write('Название группы =?');   
    readln(Group.name);
    write('Предмет (0-физика, 1 - матан, 2 - линал, 3 - инжграф, 4- прог) =?');
    readln(n);
    Group.subj := TSubj(n);
    write('Оценка за предмет:');
    readln(n);
    Group.mark := TMark(abs(n - 5));
    write('Кол-во студентов с оценкой ', markToString(Group.mark), ' =?');
    readln(Group.amount);
    write(fr, Group);   // запись записи целиком в файл
    inc(kol);
    write('Ещё? (y/n)');
    readln(ch)
  until UpCase(ch)='N';

  CloseFile(fr);

  writeln('Создан типизированный файл из ',kol,' записей');
  write('Press ENTER');
  readln;
end;

//---------------------------------------------------------------------------------------
//----------вторая часть: создание типизированного файла из текстового
Procedure CreateTypedFile2();
var
  Group: TGroup;
  ft: TextFile; // текстовый файл
  fr: file of TGroup; // типизированный файл - файл записей
  n, kol: integer;
  ch: char;
  FileName:string[80];
begin
  if ParamCount<2 then
  begin
    writeln('Мало параметров '#13#10'Press enter');
    readln;  exit
  end;

  FileName:= Paramstr(2);

  AssignFile(ft, FileName);
  Try  Reset(ft);
  Except
    writeln('Error: не удалось открыть текстовый файл ',Paramstr(2));
    write('Press ENTER'); readln;  exit
  end;
  
  FileName := ParamStr(1);
  AssignFile(fr, FileName);
  Try  ReWrite(fr);    //  или  {$I-} ReWrite(fr); {$I+} и if IOResult<>0 then <ошибка>
  Except
    writeln('Error: не удалось создать типизированный файл ',FileName);
    write('Press ENTER'); readln;  exit
  end;
  kol := 0;
  while not eof(ft) do begin
    readln(ft, Group.name);
    readln(ft, n);
    Group.subj := TSubj(n);
    readln(ft, n);
    Group.mark := TMark(abs(n - 5));
    readln(ft, Group.amount);
    write(fr, Group);
    inc(kol);
  end;
  CloseFile(ft);
  CloseFile(fr);
  writeln('Создан типизированный файл из ',kol,' записей');
  write('Press ENTER');
  readln;
end;

//--------------------------------------------------------------
//-------------- третья часть: поиск в типизированном файле ----
Procedure FindAndReplace();
var
  Group, Swap: TGroup;
  fr: file of TGroup;
  n, kol, p: integer;
  FileName:string[80];
  buf: string[15];
begin
  if ParamCount<1 then
  begin
    writeln('Мало параметров '#13#10'Press enter');
    readln;  exit
  end;

  FileName := ParamStr(1);
// или простой диалог или через параметры программы при её вызове ParamStr(1)
// writeln('Введите имя типизированного файла');
// readln(FileName); 

  AssignFile(fr, FileName);
  Try  ReSet(fr);    //  или  {$I-} ReSet(fr); {$I+} if IOResult<>0 then
  Except
    writeln('Error: не удалось открыть типизированный файл ',FileName);
    write('Press ENTER'); readln;  exit
  end;

  kol:=0;
  p:= FileSize(fr) - 1;
  while (p >= 0) and (kol=0) do begin
    seek(fr, p);
    read(fr, Group);
    n := Pos('1', Group.name);
    if (n > 0) and (Group.mark = Отлично) and (Group.amount >= 2) then begin
      buf := Group.name;
      buf[n] := '0';
      n := Pos('1', buf);
      if n > 0 then begin
         writeln('Найдена группа ', Group.name,', предмет: ', subjToString(Group.subj),', оценка: ', markToString(Group.mark), ', кол-во студентов: ', Group.amount);
         inc(kol);
         if p = 0 then 
           writeln('Найденная запись является первой, обмен не требуется')
         else begin
            Seek(fr, 0);
            read(fr, Swap);
            Seek(fr, 0);
            write(fr, Group);
            Seek(fr, p);
            write(fr, Swap);
            writeln('В файле первая запись обменялась местами с записью номер: ', p+1)
         end;
      end;
    end;
    p := p - 1;
  end;

  if kol=0 then
    writeln('Данные, соответствующие запросу, не найдены');

  CloseFile(fr);

  write('Press ENTER');  readln;
end;
//--------------------------------------------------------------
//-------------- просмотр типизированного файла ----
Procedure ViewFile();
var
  Group: TGroup;
  fr: file of TGroup;
  n, kol: integer;
  FileName:string[80];
begin
  if ParamCount<1 then
  begin
    writeln('Мало параметров '#13#10'Press enter');
    readln;  exit
  end;

  FileName := ParamStr(1);
// или простой диалог или через параметры программы при её вызове ParamStr(1)
// writeln('Введите имя типизированного файла');
// readln(FileName); 

  AssignFile(fr, FileName);
  Try  ReSet(fr);    //  или  {$I-} ReSet(fr); {$I+} if IOResult<>0 then
  Except
    writeln('Error: не удалось открыть типизированный файл ',FileName);
    write('Press ENTER'); readln;  exit
  end;

  kol:=0;
  while not eof(fr) do
  begin
    read(fr, Group); // считывание
    writeln('Найдена группа ', Group.name,', предмет: ', subjToString(Group.subj),', оценка: ', markToString(Group.mark), ', кол-во студентов: ', Group.amount);
    inc(kol);
  end;

  if kol=0 then
    writeln('Данные не найдены')
  else
    writeln('Найдено ',kol, ' записей');

  CloseFile(fr);

  write('Press ENTER');  readln;
end;

function subjToString(subj : TSubj) : string;
begin
  case Ord(subj) of          //(Физика, Матан, Линал, Инжграф, Программирование);
    0: subjToString := 'Физика';
    1: subjToString := 'Матан';
    2: subjToString := 'Линал';
    3: subjToString := 'Инжграф';
    4: subjToString := 'Программирование';
  end;
end;

function markToString(mark : TMark) : string;
begin
  case Ord(mark) of          // (Отлично, Хорошо, Удовл, Неуд);
    0: markToString := 'Отлично';
    1: markToString := 'Хорошо';
    2: markToString := 'Удовл';
    3: markToString := 'Неуд';
  end;
end;

End.