program Lab23;
 
{$APPTYPE CONSOLE}
{$MODE OBJFPC}
 
uses
 SysUtils, Classes;
 
type
 TMonth = (January, February, March, April, May, June,
 July, August, September, October, November, December);
 TEvent = record
 EventName : string[100];
 Day : byte;
 Month : TMonth;
 Year : integer;
  end;
 
function MonthFromInt(m: integer): TMonth;
begin
 Result := TMonth(m - 1);
end;
 
function MonthToStr(m: TMonth): string;
const
 Names: array[January..December] of string = (
    'январь', 'февраль', 'март', 'апрель', 'май', 'июнь',
    'июль', 'август', 'сентябрь', 'октябрь', 'ноябрь', 'декабрь');
begin
 Result := Names[m];
end;
 
function IsLater(A, B: TEvent): Boolean;
begin
 Result := (A.Year > B.Year) or
            ((A.Year = B.Year) and (Ord(A.Month) > Ord(B.Month))) or
            ((A.Year = B.Year) and (A.Month = B.Month) and (A.Day > B.Day));
end;
 
procedure SplitString(const S: string; Separator: char; var Parts: TStringList);
var
  i, Start: integer;
begin
  Parts.Clear;
  Start := 1;
  for i := 1 to Length(S) do
    if S[i] = Separator then
    begin
      Parts.Add(Copy(S, Start, i - Start));
      Start := i + 1;
    end;
  Parts.Add(Copy(S, Start, Length(S) - Start + 1));
end;
 
function GetTypedFileName: string;
begin
  if ParamCount >= 1 then
    Result := ParamStr(1)
  else
  begin
    Write('Введите имя типизированного файла: ');
    ReadLn(Result);
  end;
end;
 
procedure CreateTypedFileDialog;
var
  f: file of TEvent;
  rec: TEvent;
  m: integer;
  answer: char;
  fname: string;
begin
  fname := GetTypedFileName;
  AssignFile(f, fname);
  try
    Rewrite(f);
  except
    Writeln('Ошибка создания файла ', fname);
    ReadLn;
    Exit;
  end;
 
  repeat
    Writeln('--- Новая запись ---');
    Write('Событие: '); ReadLn(rec.EventName);
    Write('День (1..31): '); ReadLn(rec.Day);
    repeat
      Write('Месяц (1..12): '); ReadLn(m);
    until (m >= 1) and (m <= 12);
    rec.Month := MonthFromInt(m);
    Write('Год: '); ReadLn(rec.Year);
    Write(f, rec);
    Write('Добавить ещё? (y/n): '); ReadLn(answer);
  until UpCase(answer) = 'N';
 
  CloseFile(f);
  Writeln('Файл ', fname, ' успешно создан.');
  ReadLn;
end;
 
procedure CreateTypedFileFromText;
var
  tf: TextFile;
  f: file of TEvent;
  rec: TEvent;
  line: string;
  parts: TStringList;
  fname_typed, fname_text: string;
begin
  if ParamCount >= 2 then
    fname_text := ParamStr(2)
  else
  begin
    Write('Введите имя текстового файла: ');
    ReadLn(fname_text);
  end;
  fname_typed := GetTypedFileName;
 
  AssignFile(tf, fname_text);
  try
    Reset(tf);
  except
    Writeln('Не удалось открыть текстовый файл ', fname_text);
    ReadLn;
    Exit;
  end;
 
  AssignFile(f, fname_typed);
  try
    Rewrite(f);
  except
    Writeln('Ошибка создания типизированного файла ', fname_typed);
    CloseFile(tf);
    ReadLn;
    Exit;
  end;
 
  parts := TStringList.Create;
  try
    while not Eof(tf) do
    begin
      ReadLn(tf, line);
      if Trim(line) = '' then Continue;
      SplitString(line, ';', parts);
      if parts.Count < 4 then
      begin
        Writeln('Ошибка в строке: ', line, ' – пропущена');
        Continue;
      end;
      rec.EventName := parts[0];
      rec.Day := StrToIntDef(parts[1], 1);
      rec.Month := MonthFromInt(StrToIntDef(parts[2], 1));
      rec.Year := StrToIntDef(parts[3], 2000);
      Write(f, rec);
    end;
  finally
    parts.Free;
  end;
 
  CloseFile(tf);
  CloseFile(f);
  Writeln('Типизированный файл создан из ', fname_text);
  ReadLn;
end;
 
procedure ViewFile;
var
  f: file of TEvent;
  rec: TEvent;
  count: integer;
  fname: string;
begin
  fname := GetTypedFileName;
  AssignFile(f, fname);
  try
    Reset(f);
  except
    Writeln('Ошибка открытия файла ', fname);
    ReadLn;
    Exit;
  end;
 
  count := 0;
  while not Eof(f) do
  begin
    Read(f, rec);
    Inc(count);
    Writeln(count, ': ', rec.EventName, ', ', rec.Day, ' ', MonthToStr(rec.Month),
            ' ', rec.Year, ' г.');
  end;
  if count = 0 then
    Writeln('Файл пуст.')
  else
    Writeln('Всего записей: ', count);
  CloseFile(f);
  ReadLn;
end;
 
procedure FindAndSwapWithLast;
var
  f: file of TEvent;
  rec, candidate, lastRec: TEvent;
  bestPos, lastPos, curPos: integer;
  found: boolean;
 letter: string;
 fname: string;
begin
 fname := GetTypedFileName;
 AssignFile(f, fname);
  try
 Reset(f);
  except
    Writeln('Ошибка открытия файла ', fname);
    ReadLn;
 Exit;
  end;
 
  Write('Введите букву, с которой начинается событие: ');
  ReadLn(letter);
  if letter = '' then
  begin
    Writeln('Буква не введена.');
 CloseFile(f);
    ReadLn;
 Exit;
  end;
 letter := UpperCase(letter)[1];
 
 found := False;
 bestPos := -1;
  while not Eof(f) do
  begin
    Read(f, rec);
    if (Length(rec.EventName) > 0) and (UpperCase(rec.EventName)[1] = letter) then
    begin
      if not found then
      begin
		candidate := rec;
		bestPos := FilePos(f);
		found := True;
      end
      else if IsLater(rec, candidate) then
      begin
        candidate := rec;
		bestPos := FilePos(f);
      end;
    end;
  end;
 
  if not found then
  begin
    Writeln('Записей, начинающихся на букву "', letter, '", не найдено.');
 CloseFile(f);
    ReadLn;
 Exit;
  end;
 
 lastPos := FileSize(f) - 1;
  if bestPos = lastPos then
  begin
    Writeln('Найденная запись уже является последней. Перестановка не требуется.');
 CloseFile(f);
    ReadLn;
 Exit;
  end;
 
 Seek(f, lastPos);
  Read(f, lastRec);
 Seek(f, lastPos);
  Write(f, candidate);
 Seek(f, bestPos);
  Write(f, lastRec);
 
  Writeln('Перестановка выполнена: запись ', bestPos+1,
          ' (', candidate.EventName, ') и запись ', lastPos+1,
          ' (', lastRec.EventName, ') поменяны местами.');
  CloseFile(f);
  ReadLn;
end;
 
var
 ch: char;
begin
  repeat
    Writeln('-----------------------------------');
    Writeln('D - создать типизированный файл (диалог)');
    Writeln('N - создать из текстового файла');
    Writeln('F - найти запись и переставить с последней');
    Writeln('V - просмотр файла');
    Writeln('E - выход');
    Write('Ваш выбор: ');
    ReadLn(ch);
    Writeln('-----------------------------------');
 ch := UpCase(ch);
    case ch of
      'D': CreateTypedFileDialog;
      'N': CreateTypedFileFromText;
      'F': FindAndSwapWithLast;
      'V': ViewFile;
      'E': Exit;
    else
      Writeln('Нет такой команды');
      Write('Press ENTER');
      ReadLn;
    end;
  until ch = 'E';
end.