Задание 2 Delphi (Лабораторная работа 3)

Program Lab2;

Uses
    System.SysUtils;

Type
    TArray = Array[0..3] Of Integer;
    TSet = Set Of Char;

Const
    INPUT = 1;
    OUTPUT = 2;
    NULL_CODE = 48;
    NINE_CODE = 57;

Function ChooseWay(Const IorOput: Integer): Integer;
Var
    Choice: Integer;
    IsCorrect: Boolean;
Begin
    Case IorOput Of
        INPUT:
        Begin
            Writeln('Выберите вариант ввода:');
            Writeln('1.Данные вводятся из текстового файла.');
            Writeln('2.Данные вводятся через консоль.');
        End;
        OUTPUT:
        Begin
            Writeln('Выберите вариант вывода:');
            Writeln('1.Данные выводятся в текстовый файл.');
            Writeln('2.Данные выводятся в консоль.');
        End;
    End;
    Repeat
        IsCorrect := True;
        Try
            Readln(Choice);
        Except
            Writeln('Ошибка ввода. Выберите вариант 1 или 2.');
            IsCorrect := False;
        End;
        If IsCorrect And ((Choice < 1) Or (Choice > 2)) Then
        Begin
            Writeln('Ошибка ввода. Выберите вариант 1 или 2.');
            IsCorrect := False;
        End;
    Until IsCorrect;
    ChooseWay := Choice;
End;

Function InputFileName(Const InOrOut: Integer): String;
Var
    CheckFile: TextFile;
    FileName: String;
    IsCorrect: Boolean;
Begin
    Case (InOrOut) Of
        INPUT:
        Begin
            Writeln('Введите имя файла, из которого будут вводиться данные:');
            Repeat
                IsCorrect := True;
                Readln(FileName);
                If ExtractFileExt(FileName) = '.txt' Then
                Begin
                    If Not FileExists(FileName) Then
                    Begin
                        Writeln('Файла с таким именем не существует. Повторите ввод имени файла.');
                        IsCorrect := False;
                    End
                    Else
                        Try
                            Assign(CheckFile, FileName);
                            Reset(CheckFile);
                            Close(CheckFile);
                        Except
                            Writeln('Невозможно открыть файл с таким именем! Повторите ввод имени файла:');
                            IsCorrect := False;
                        End;
                End
                Else
                Begin
                    Writeln('Файл должен иметь расширение .txt! Повторите ввод имени файла.');
                    IsCorrect := False;
                End;
            Until IsCorrect;
            InputFileName := FileName;
        End;
        OUTPUT:
        Begin
            Writeln('Введите имя файла, в который будут выводиться полученные данные (если файл вводится без расширения, то ему автоматически будет добавлено расширение .txt):');
            Repeat
                IsCorrect := True;
                Readln(FileName);
                If ExtractFileExt(FileName) = '' Then
                    FileName := FileName + '.txt';
                Try
                    Assign(CheckFile, FileName);
                    ReWrite(CheckFile);
                    Close(CheckFile);
                Except
                    Writeln('Невозможно открыть для записи файл с таким именем! Повторите ввод имени файла:');
                    IsCorrect := False;
                End;
            Until IsCorrect;
            InputFileName := FileName;
        End;
    End;
End;

Procedure InputFromFile(Var Text: AnsiString; Var FileName: String);
Var
    FileString: String;
    InputFile: TextFile;
Begin
    Text := '';
    Assign(InputFile, FileName);
    Reset(InputFile);
    While (Not EoF(InputFile)) Do
    Begin
        Readln(InputFile, FileString);
        Text := Text + FileString;
    End;
    Close(InputFile);
End;

Procedure InputFromConsole(Var Text: AnsiString);
Begin
    Writeln('Введите строку для обработки:');
    Readln(Text);
End;

Procedure InputText(Var Text: AnsiString; Var Choice: Integer);
Var
    FileName: String;
    InputFile: TextFile;
Begin
    Case Choice Of
        1:
        Begin
            FileName := InputFileName(INPUT);
            InputFromFile(Text, FileName);
        End;
        2:
            InputFromConsole(Text);
    End;
End;

Procedure OutputInFile(Var FileName: String; Var ResultSet: TSet);
Var
    OutputFile: TextFile;
    I: Char;
Begin
    Assign(OutputFile, FileName);
    ReWrite(OutputFile);
    For I In ResultSet Do
        Write(OutputFile, I, ' ');
    Close(OutputFile);
End;

Procedure OutputInConsole(Var ResultSet: TSet);
Var
    I: Char;
Begin
    Writeln('Искомое множество:');
    For I In ResultSet Do
        Write(I, ' ');
End;

Procedure OutputResult(Var ResultSet: TSet; Var Choice: Integer);
Var
    FileName: String;
Begin
    Case Choice Of
        1:
        Begin
            FileName := InputFileName(OUTPUT);
            OutputInFile(FileName, ResultSet);
            Write('Искомые данные выведены в файл ');
            Writeln(FileName);
        End;
        2:
            OutputInConsole(ResultSet);
    End;
End;

Procedure SearchNumsAndSigns(Var ResultSet: TSet; Var NumsAndSigns: TSet; Var Text: AnsiString);
Var
    I: Integer;
Begin
    For I := 1 To High(Text) Do
        If Text[I] In NumsAndSigns Then
            Include(ResultSet, Text[I]);
End;

Var
    Text: AnsiString;
    Choice: Integer;
    NumsAndSigns: TSet = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '-', '/', '*'];
    ResultSet: TSet;
Begin
    Writeln('Программа выводит содержащиеся в тексте (текст должен содержать от 1 до 4 цифровых символов, отображающих целые числа от 1 до 2000) числа в десятичной и римской системах счисления.');
    Choice := ChooseWay(INPUT);
    InputText(Text, Choice);
    SearchNumsAndSigns(ResultSet, NumsAndSigns, Text);
    Choice := ChooseWay(OUTPUT);
    OutputResult(ResultSet, Choice);
    Readln;
End.