Lab3_2

Program Lab3_2;

Uses
    System.SysUtils,
    Classes;

Type
    TSet1 = Set Of AnsiChar;
    TSet2 = Set Of AnsiChar;
    TErrorCode = (CORRECT, INCORRECT_CHOICE, NON_NUMERIC, OUT_OF_RANGE, FILE_NOT_TXT, FILE_NOT_EXIST, FILE_NOT_READABLE, FILE_NOT_WRITABLE,
        FILE_NOT_CLOSE, FILE_IS_EMPTY, READING_GO_WRONG, FILE_NOT_FULL, STRING_OUT_OF_RANGE, TOO_MUCH);

Const
    MIN_NUM = 0;
    MAX_NUM = 255;
    MIN_EXT = 5;
    MIN_LEN = 1;
    MAX_LEN = 32;
    MIN_OPTION = 1;
    MAX_OPTION = 2;
    Err: Array [TErrorCode] Of String = ('', 'Error. Incorrect choice. Please try again.', 'Error. Non-numeric value. Please try again. ',
        'Error. Out of Range. Please try again. ', 'Error. File not .txt. Please try again', 'Error. File not Exist. Please try again.',
        'Error. File not readable. Please try again.', 'Error. File not writable. Please try again.',
        'Error. File not closeable. Please try again.', 'Error. File is empty. Please try again.',
        'Error. Reading went wrong. Please try again.', 'Error. The file lacks sufficient information.',
        'Error. String out of Range. Please try again. ', 'Error. Too much information in the file.  Please try again.');

Procedure ProgramTask();
Begin
    Writeln('This program extracts unique characters from a string and forms a set of digits and punctuation marks.');
End;

Function ExtractSubstring(Const Str: String; Const PosStart, PosEnd: Integer): String;
Var
    I: Integer;
    PartStr: String;
Begin
    PartStr := '';
    For I := PosStart To PosEnd Do
        PartStr := PartStr + Str[I];
    ExtractSubstring := PartStr;
End;

Function IsFileTxt(Const PathToFile: String): TErrorCode;
Var
    ErrorCode: TErrorCode;
    Len: Integer;
Begin
    ErrorCode := CORRECT;
    Len := Length(PathToFile);
    If (Len < MIN_EXT) Or (ExtractSubstring(PathToFile, Len - 3, Len) <> '.txt') Then
        ErrorCode := FILE_NOT_TXT;
    IsFileTxt := ErrorCode;
End;

Function IsFileExist(Const PathToFile: String): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    If Not FileExists(PathToFile) Then
        ErrorCode := FILE_NOT_EXIST;
    IsFileExist := ErrorCode;
End;

Function IsFileReadable(Var FileName: TextFile): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    Try
        Reset(FileName);
    Except
        ErrorCode := FILE_NOT_READABLE
    End;
    IsFileReadable := ErrorCode;
End;

Function IsFileWritable(Var FileName: TextFile): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    Try
        Append(FileName);
    Except
        ErrorCode := FILE_NOT_WRITABLE;
    End;
    IsFileWritable := ErrorCode;
End;

Function IsFileCloseable(Var FileName: TextFile): TErrorCode;
Var
    ErrorCode: TErrorCode;
Begin
    ErrorCode := CORRECT;
    Try
        CloseFile(FileName);
    Except
        ErrorCode := FILE_NOT_CLOSE
    End;
    IsFileCloseable := ErrorCode;
End;

Procedure GetInputFilePath(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := IsFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := IsFileTxt(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := IsFileReadable(FileName);
        If (Error = CORRECT) And (EOF(FileName)) Then
            Error := FILE_IS_EMPTY;
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure GetOutputFilePath(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := IsFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := IsFileTxt(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := IsFileWritable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Function ReadStringFromConsole(Const MIN_COUNT, MAX_COUNT: Integer): AnsiString;
Var
    Str: AnsiString;
    Error: TErrorCode;
Begin
    Repeat
        Writeln('Please write a sequence of characters (1 to 32 symbols).');
        Error := CORRECT;
        Readln(Str);
        If (Length(Str) < MIN_COUNT) Or (Length(Str) > MAX_COUNT) Then
            Error := STRING_OUT_OF_RANGE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    ReadStringFromConsole := Str;
End;

Function FindFileStringNumber(Var FileName: TextFile): Integer;
Var
    Counter: Integer;
Begin
    Counter := 0;
    While Not EOF(FileName) Do
    Begin
        Readln(FileName);
        Inc(Counter);
    End;
    FindFileStringNumber := Counter;
End;

Function ReadStringFromFile(Const MIN_COUNT, MAX_COUNT: Integer): AnsiString;
Var
    Counter: Integer;
    Str: AnsiString;
    FileName: TextFile;
    Error: TErrorCode;
Begin
    Repeat
        WriteLn('Enter the path to the file with extension ".txt"');
        Error := CORRECT;
        GetInputFilePath(FileName);
        Counter := FindFileStringNumber(FileName);
        If Counter < 1 Then
            Error := FILE_NOT_FULL;
        If Counter > 1 Then
        Begin
            Error := TOO_MUCH;
            Writeln(ERR[Error]);
            Str := ReadStringFromConsole(MIN_COUNT, MAX_COUNT);
            Error := CORRECT;
        End
        Else
        Begin
            Reset(FileName);
            ReadLn(FileName, Str);
            If (Length(Str) < MIN_COUNT) Or (Length(Str) > MAX_COUNT) Then
                Error := STRING_OUT_OF_RANGE;
            If Error <> CORRECT Then
            Begin
                Write(ERR[Error]);
                Writeln('Please write string');
                Str := ReadStringFromConsole(MIN_COUNT, MAX_COUNT);
            End;
        End;
        Error := IsFileCloseable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
    ReadStringFromFile := Str;
End;

Function GetUserOption(): Integer;
Var
    Error: TErrorCode;
    Option: Integer;
Begin
    Option := 0;
    Repeat
        Error := CORRECT;
        Try
            Readln(Option);
        Except
            Error := NON_NUMERIC;
        End;
        If (Error = CORRECT) And ((Option < MIN_OPTION) Or (Option > MAX_OPTION)) Then
            Error := INCORRECT_CHOICE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    GetUserOption := Option;
End;

Procedure ChooseInputMethod(Var Str: AnsiString);
Var
    Option: Integer;
Begin
    Writeln('If you want to read from console enter: 1');
    Writeln('If you want to read from File enter: 2');
    Option := GetUserOption();
    If Option = MAX_OPTION Then
        Str := ReadStringFromFile(MIN_LEN, MAX_LEN)
    Else
        Str := ReadStringFromConsole(MIN_LEN, MAX_LEN);
End;

Function CreateSetOfUniqueChars(Const Str: AnsiString): TSet1;
Var
    UniqueChars: TSet1;
    Ch: AnsiChar;
    I: Integer;
Begin
    UniqueChars := [];
    For I := 1 To Length(Str) Do
    Begin
        Ch := Str[I];
        Include(UniqueChars, Ch);
    End;
    CreateSetOfUniqueChars := UniqueChars;
End;

Function CreateSetOfDigitsAndPunctuation(Const UniqueChars: TSet1): TSet2;
Var
    DigitsAndPunctuation: TSet2;
    Ch: AnsiChar;
Begin
    DigitsAndPunctuation := [];
    For Ch In UniqueChars Do
    Begin
        If Ch In ['0' .. '9', '.', ',', ';', ':', '!', '?', '-', '(', ')', '"', ''''] Then
            Include(DigitsAndPunctuation, Ch);
    End;
    CreateSetOfDigitsAndPunctuation := DigitsAndPunctuation;
End;

Function CreateStringFromSet(Const CharSet: TSet1): AnsiString;
Var
    Str: AnsiString;
    Ch: AnsiChar;
Begin
    Str := '';
    For Ch In CharSet Do
        Str := Str + Ch + ' ';
    CreateStringFromSet := Str;
End;

Procedure PrintFile(Const Str1, Str2: AnsiString);
Var
    FileName: TextFile;
    ErrorCode: TErrorCode;
Begin
    Repeat
        Writeln('Enter the name of the output file with extension ".txt":');
        GetOutputFilePath(FileName);
        ErrorCode := CORRECT;
        Rewrite(FileName);
        Writeln(FileName, 'Unique characters:');
        Writeln(FileName, Str1);
        Writeln(FileName, 'Digits and punctuation:');
        Writeln(FileName, Str2);
        ErrorCode := IsFileCloseable(FileName);
        If ErrorCode <> CORRECT Then
            Writeln(ERR[ErrorCode]);
    Until ErrorCode = CORRECT;
    Writeln('Results saved to file.');
End;

Procedure PrintConsole(Const Str1, Str2: AnsiString);
Begin
    WriteLn('');
    WriteLn('Unique characters:');
    WriteLn(Str1);
    WriteLn('Digits and punctuation:');
    WriteLn(Str2);
End;

Procedure PrintAnswer(Const Str1, Str2: AnsiString);
Var
    Option: Integer;
Begin
    Writeln('Print to console (1) or file (2)?');
    Option := GetUserOption();
    If Option = MAX_OPTION Then
        PrintFile(Str1, Str2)
    Else
        PrintConsole(Str1, Str2);
End;

Var
    Str, UniqueCharsStr, DigitsAndPunctuationStr: AnsiString;
    UniqueChars: TSet1;
    DigitsAndPunctuation: TSet2;

Begin
    ProgramTask();
    ChooseInputMethod(Str);
    UniqueChars := CreateSetOfUniqueChars(Str);
    DigitsAndPunctuation := CreateSetOfDigitsAndPunctuation(UniqueChars);
    UniqueCharsStr := CreateStringFromSet(UniqueChars);
    DigitsAndPunctuationStr := CreateStringFromSet(DigitsAndPunctuation);
    PrintAnswer(UniqueCharsStr, DigitsAndPunctuationStr);
    Writeln('Press Enter to exit.');
    Readln;
End.