lab2.pas

Unit  ULab2;
Interface

Type
  TName = (bus, tram, train, air); // автобус, трамвай, поезд, самолет
  TRoute = record
        Name: TName; // вид транспорта
        Number: String[10]; // номер маршрута
        Date: record // дата утверждения маршрута
            d,m,y: integer;
        end;
  end;

Procedure CreateTypedFile1(); // создание типизированного в диалоге
Procedure CreateTypedFile2(); // создание типизированного файла из текстового
Procedure Find(); // поиск и редактирование
Procedure ViewFile(); // просмотр типизированного файла
procedure swap(typeFile: file of TRoute; swap1, swap2: integer); // обмен

 Implementation

Procedure CreateTypedFile1(); // создание типизированного в диалоге
var
    Route: TRoute;
    TFile: file of TRoute; // типизированный файл - файл записей
    tempName: string;
    number: integer;
    ch: char;
    FileName: string[80];
begin

    writeln('Введите имя типизированного файла');
    readln(FileName);

   AssignFile(TFile, FileName);
    Try  Rewrite(TFile);
  Except
    writeln('Ошибка: не удалось создать типизированный файл ',FileName);
    write('Press ENTER'); readln;  exit
  end;

   number:=0;
   repeat
    write('Вид транспорта: '); readln(tempName);

    case tempName of
    'автобус': Route.Name:= bus;
    'трамвай': Route.Name:= tram;
    'поезд': Route.Name:= train;
    'самолет': Route.Name:= air;

    else
            begin
                writeln('Такого транспорта нет!');
                exit;
            end;
    end;

    write('Номер маршрута:'); readln(Route.Number);
    write('Дата утверждения маршрута:');  readln(Route.Date.d, Route.Date.m, Route.Date.y);

    write(TFile, Route);   // запись записи целиком в файл
    inc(number);

    write('Ещё? (y/n)');
    readln(ch)
   until UpCase(ch)='N';

   CloseFile(Tfile);

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


Procedure CreateTypedFile2(); // создание типизированного файла из текстового
var
    Route: TRoute;
    Text: TextFile; // текстовый файл
    TFile: file of TRoute; // типизированный файл - файл записей
    FileName, TFileName:string[80];
    tempName: string;
begin
    writeln('Введите имя текстового файла');
    readln(FileName);
    AssignFile(Text, FileName);

    writeln('Введите имя типизированного файла');
    readln(TFileName);
    AssignFile(TFile, TFileName);
    Try  Reset(Text);
    Except
        writeln('Ошибка: не удалось открыть текстовый файл ', FileName);
    write('Press ENTER'); readln;  exit
    end;

    Try Rewrite(TFile);
    Except
        writeln('Ошибка: не удалось создать типизированный файл ', TFileName);
        write('Press ENTER'); readln; exit
    end;

    while not eof(Text) do
    begin
            readln(Text, tempName);
            readln(Text, Route.Number);
            readln(Text, Route.Date.d, Route.Date.m, Route.Date.y);

            case tempName of
                'автобус': Route.Name:= bus;
          'трамвай': Route.Name:= tram;
          'поезд': Route.Name:= train;
          'самолет': Route.Name:= air;
        end;


        write(TFile, Route);
   end;

   CloseFile(text);
   CloseFile(TFile);
   write('Press ENTER');
    readln;
end;

procedure swap(typeFile: file of TRoute; swap1, swap2: integer);
begin
    var copy1, copy2 : TRoute;
    seek(typeFile, swap1); read(typeFile, copy1);   // копируем первый
    seek(typeFile, swap2); read(typeFile, copy2);   // копируем второй
    seek(typeFile, swap1); write(typeFile, copy2);  // второй помещаем на место первого
    seek(typeFile, swap2); write(typeFile, copy1);   // первый на место второго
end;


Procedure ViewFile(); // просмотр типизированного файла
var
  Route: TRoute;
  TFile: file of TRoute;
  number: integer;
  tempName: string;
  FileName:string[80];
begin
    writeln('Введите имя типизированного файла');
    readln(FileName);
    AssignFile(TFile, FileName);


    Try  Reset(TFile);
    Except
        writeln('Ошибка: не удалось открыть типизированный файл ',FileName);
        write('Press ENTER'); readln;  exit
    end;

    number:=0;
    while not eof(Tfile) do
    begin
        read(TFile, Route); // считывание

        case Route.Name of
                bus: tempName:='автобус';
                tram: tempName:='трамвай';
                train: tempName:='поезд';
                air: tempName:='самолет';
        end;

        writeln('Найден ', tempName,', ',Route.Number,', ', Route.Date.d, '.', Route.Date.m, '.', Route.Date.y);
        inc(number);
    end;

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

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

Procedure Find();
var
  Route, min: TRoute;
  TFile: file of TRoute;
  k: integer;
  n: byte;
  tdate, mdate: integer;
  flag: boolean;
  FileName:string[80];
  tempName:string;
begin
   writeln('Введите имя типизированного файла');
   readln(FileName);
   AssignFile(TFile, FileName);
   Try  Reset(TFile);
   Except
      writeln('Ошибка: не удалось открыть типизированный файл ',FileName);
      write('Press ENTER'); readln;  exit
   end;



  flag:=false;
  tdate:=0;
  while not eof(TFile) and flag=false do
  begin
     read(TFile, Route);
     n:=FilePos(TFile);
     flag:=true;
     min:=Route;
     mdate:= Route.Date.d + Route.Date.m*31 + Route.Date.y*365;
  end;

  reset(TFile);
  while not eof(TFile) do
  begin
     read(TFile, Route); // считывание
     tdate:= Route.Date.d + Route.Date.m*31 + Route.Date.y*365;
       if tdate <= mdate then
       begin
          n:=FilePos(TFile);
          min:=Route;
          mdate:= tdate;
       end;
     end;


   if flag=false then writeln('Данные, соответствующие запросу, не найдены')
  else
  begin
     writeln('Введите число k: '); readln(k);
     k:=k-1;
     n:=n-1;
     case min.Name of
                bus: tempName:='автобус';
                tram: tempName:='трамвай';
                train: tempName:='поезд';
                air: tempName:='самолет';
        end;
     writeln('Самый давний утвержденный маршрут: ', tempName,' ',min.Number,' ', min.Date.d, '.', min.Date.m, '.', min.Date.y);
     writeln('Старая позиция в файле: ', n+1, '. Новая позиция в файле: ', k+1);

     if k >= n then
     for var j: integer := n to k-1 do
        swap(TFile,j,j+1)
     else
     for var j: integer := n downto k+1 do
         swap(TFile,j,j-1);
 end;

   CloseFile(TFile);

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

end.