Advertisement
green1ant

3_2 *3

Nov 8th, 2018
251
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.52 KB | None | 0 0
  1. program Laba_3_2;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.    SysUtils;
  5. type
  6.    TInputMode = (WithFile, Console);
  7.    TSet = set of Char;
  8.  
  9. resourcestring
  10.    InstructionMessage
  11.       = 'This program composes a set consisting of arithmetic operands and even digits';
  12.    WayOfInputMessage = 'Where do you want to input data from? [F]ile or [C]onsole';
  13.    IncorrectInputFilePathMessage = 'Incorrect input file path, check if file exists and try again';
  14.    IncorrectWayOfInputMessage = 'Incorrect way of input, choose [F]ile or [C]onsole';
  15.    OutputFileExistsErrorMessage = 'Incorrect output file, such file already exists, try again';
  16.    ShouldCreateMessage = 'Do you want to create output file? [Y]es or [N]o';
  17.    ShouldCreateErrorMessage = 'Incorrect answer, choose [Y]es or [N]o';
  18.    EmptySequenceMessage = 'Your sequence doesn''t contain any of assumed symbols';
  19.    OutputMessage = 'Composed set based on your sequence';
  20.    Mask = '-+*/02468';
  21.  
  22. function GetInputFilePath: string;
  23. var
  24.    Path: string;
  25. begin
  26.    Writeln('Enter input file path');
  27.    Readln(Path);
  28.    while not FileExists(Path) do
  29.    begin
  30.       Writeln(IncorrectInputFilePathMessage);
  31.       Readln(Path);
  32.    end;
  33.    GetInputFilePath := Path;
  34. end;
  35.  
  36. function ShouldCreateOutputFile: Boolean;
  37. var
  38.    Answer: string;
  39. begin
  40.    Writeln(ShouldCreateMessage);
  41.    Readln(Answer);
  42.    Answer := LowerCase(Answer);
  43.    while (Answer <> 'y') and (Answer <> 'n') do
  44.    begin
  45.       Writeln(ShouldCreateErrorMessage);
  46.       Readln(Answer);
  47.    end;
  48.    ShouldCreateOutputFile := Answer = 'y';
  49. end;
  50.  
  51. function GetOutputFilePath: string;
  52. var
  53.    Path: string;
  54. begin
  55.    Writeln('Enter output file path');
  56.    Readln(Path);
  57.    while FileExists(Path) do
  58.    begin
  59.       Writeln(OutputFileExistsErrorMessage);
  60.       Readln(Path);
  61.    end;
  62.    GetOutputFilePath := Path;
  63. end;
  64.  
  65. function ChooseInputMode(var OutputFilePath: string): TInputMode;
  66. var
  67.    Mode: string;
  68. begin
  69.    Writeln(WayOfInputMessage);
  70.    Readln(Mode);
  71.    Mode := LowerCase(Mode);
  72.    while (Mode <> 'c') and (Mode <> 'f') do
  73.    begin
  74.       Writeln(IncorrectWayOfInputMessage);
  75.       Readln(Mode);
  76.    end;
  77.    if ShouldCreateOutputFile() then
  78.       OutputFilePath := GetOutputFilePath()
  79.    else
  80.       OutputFilePath := '';
  81.  
  82.    if Mode = 'f' then
  83.       ChooseInputMode := WithFile
  84.    else
  85.       ChooseInputMode := Console;
  86. end;
  87.  
  88. function ReadFromFile(InputFilePath: string): string;
  89. var
  90.    InputFile: TextFile;
  91.    InputString: string;
  92. begin
  93.    AssignFile(InputFile, InputFilePath);
  94.    Reset(InputFile);
  95.    Readln(InputFile, InputString);
  96.    CloseFile(InputFile);
  97.    ReadFromFile := InputString;
  98. end;
  99.  
  100. function ReadFromConsole(): string;
  101. var
  102.    InputString: string;
  103. begin
  104.    Writeln('Input sequence of symbols');
  105.    Readln(InputString);
  106.    ReadFromConsole := InputString;
  107. end;
  108.  
  109. function GetSetFromString(InputString: string): TSet;
  110. var
  111.    StringLength, i: Integer;
  112.    Sequence: TSet;
  113. begin
  114.    Sequence := [];
  115.    StringLength := Length(InputString);
  116.    for i := 1 to StringLength do
  117.       if (Pos(InputString[i], Mask) <> 0) and not(InputString[i] in Sequence) then
  118.          Include(Sequence, InputString[i]);
  119.    GetSetFromString := Sequence;
  120. end;
  121.  
  122. procedure PrintSetToConsole(Sequence: TSet);
  123. var
  124.    i: Integer;
  125. begin
  126.    if Sequence = [] then
  127.       Writeln(EmptySequenceMessage)
  128.    else
  129.    begin
  130.       Writeln(OutputMessage);
  131.       for i := 0 to 255 do
  132.          if Chr(i) in Sequence then
  133.             Write(Chr(i), ' ');
  134.    end;
  135. end;
  136.  
  137. procedure PrintSetToFile(Sequence: TSet; OutputFilePath: string);
  138. var
  139.    i: Integer;
  140.    OutputFile: TextFile;
  141. begin
  142.    AssignFile(OutputFile, OutputFilePath);
  143.    Rewrite(OutputFile);
  144.    if Sequence = [] then
  145.       Writeln(OutputFile, EmptySequenceMessage)
  146.    else
  147.    begin
  148.       Writeln(OutputFile, OutputMessage);
  149.       for i := 0 to 255 do
  150.          if Chr(i) in Sequence then
  151.             Write(OutputFile, Chr(i), ' ');
  152.    end;
  153.    CloseFile(OutputFile);
  154. end;
  155.  
  156. procedure Main;
  157. var
  158.    InputFilePath, OutputFilePath, InputString: string;
  159.    Sequence: TSet;
  160. begin
  161.    Writeln(InstructionMessage);
  162.    case ChooseInputMode(OutputFilePath) of
  163.       WithFile:
  164.       begin
  165.          InputFilePath := GetInputFilePath();
  166.          InputString := ReadFromFile(InputFilePath);
  167.       end;
  168.       Console:
  169.          InputString := ReadFromConsole();
  170.    end;
  171.    Sequence := GetSetFromString(InputString);
  172.    if OutputFilePath <> '' then
  173.       PrintSetToFile(Sequence, OutputFilePath);
  174.    PrintSetToConsole(Sequence);
  175.    Readln;
  176. end;
  177.  
  178. begin
  179.    Main();
  180. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement