Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program Laba_3_2;
- {$APPTYPE CONSOLE}
- uses
- SysUtils;
- type
- TInputChoice = (WithFile, Console);
- TSet = set of Char;
- const
- InstructionMessage
- = 'This program composes a set consisting of arithmetic operands and even digits';
- WayOfInputMessage = 'Where do you want to input data from? [F]ile or [C]onsole?';
- IncorrectInputFilePath = 'Incorrect input file path, check if file exists and try again';
- IncorrectWayOfInputMessage = 'Incorrect way of input, choose [F]ile or [C]onsole';
- OutputFileExistsErrorMessage = 'Incorrect output file, such file already exists, try again';
- Mask = '-+*/02468';
- function GetInputFilePath(): string;//ïðîâåðêà íà ïóñòîòó
- var
- Path: string;
- begin
- Writeln('Enter input file path');
- Readln(Path);
- while not FileExists(Path) do
- begin
- Writeln(IncorrectInputFilePath);
- Readln(Path);
- end;
- GetInputFilePath := Path;
- end;
- function GetOutputFilePath(): string;
- var
- Path: string;
- begin
- Writeln('Enter output file path');
- Readln(Path);
- while FileExists(Path) do
- begin
- Writeln(OutputFileExistsErrorMessage);
- Readln(Path);
- end;
- GetOutputFilePath := Path;
- end;
- function ChooseInputFromFileOrConsole(): TInputChoice;
- var
- Choice: string;
- begin
- Writeln(WayOfInputMessage);
- Readln(Choice);
- while (LowerCase(Choice) <> 'c') and (LowerCase(Choice) <> 'f') do
- begin
- Writeln(IncorrectWayOfInputMessage);
- Readln(Choice);
- end;
- if LowerCase(Choice) = 'f' then
- ChooseInputFromFileOrConsole := WithFile
- else
- ChooseInputFromFileOrConsole := Console;
- end;
- function GetStringFromFile(InputFilePath: string): string;
- var
- InputFile: TextFile;
- InputString: string;
- begin
- AssignFile(InputFile, InputFilePath);
- Reset(InputFile);
- Readln(InputFile, InputString);
- CloseFile(InputFile);
- GetStringFromFile := InputString;
- end;
- function GetStringFromConsole(): string;
- var
- InputString: string;
- begin
- Readln(InputString);
- GetStringFromConsole := InputString;
- end;
- function GetSetFromString(InputString: string): TSet;
- var
- StringLength, i: Integer;
- Sequence: TSet;
- begin
- Sequence := [];
- StringLength := Length(InputString);
- for i := 1 to StringLength do
- if (Pos(InputString[i], Mask) <> 0) and not(InputString[i] in Sequence) then
- Include(Sequence, InputString[i]);
- GetSetFromString := Sequence;
- end;
- procedure PrintSetToConsole(Sequence: TSet);
- var
- i: Integer;
- begin
- if Sequence = [] then
- Writeln('Your sequence doesn''t contain any of assumed symbols')
- else
- begin
- Writeln('Composed set based on your sequence');
- for i := 0 to 255 do
- if Chr(i) in Sequence then
- Write(Chr(i), ' ');
- end;
- end;
- procedure PrintSetToFile(Sequence: TSet; OutputFilePath: string);
- var
- i: Integer;
- OutputFile: TextFile;
- begin
- AssignFile(OutputFile, OutputFilePath);
- Rewrite(OutputFile);
- if Sequence = [] then
- Writeln(OutputFile, 'Your sequence doesn''t contain any of assumed symbols')
- else
- begin
- Writeln(OutputFile, 'Composed set based on your sequence');
- for i := 0 to 255 do
- if Chr(i) in Sequence then
- Write(OutputFile, Chr(i), ' ');
- end;
- CloseFile(OutputFile);
- end;
- procedure PrintSet(Sequence: TSet; OutputFilePath: string);//ïîäóìàòü íóæíà ëè òàêàÿ ôöèÿ
- begin
- PrintSetToConsole(Sequence);
- PrintSetToFile(Sequence, OutputFilePath);
- end;
- procedure Main();
- var
- InputFilePath, OutputFilePath, InputString: string;
- SequenceString: TSet;
- begin
- Writeln(InstructionMessage);
- if ChooseInputFromFileOrConsole = WithFile then
- begin
- InputFilePath := GetInputFilePath();//ìîæíî çàñóíóòü â íèæíþþ ôöèþ
- InputString := GetStringFromFile(InputFilePath);
- OutputFilePath := GetOutputFilePath();
- SequenceString := GetSetFromString(InputString);
- PrintSet(SequenceString, OutputFilePath);
- end
- else
- begin
- Writeln('Input sequence of symbols');
- InputString := GetStringFromConsole();
- SequenceString := GetSetFromString(InputString);
- PrintSetToConsole(SequenceString);
- end;
- Readln;
- end;
- begin
- Main();
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement