Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Program Lab3Challenge3;
- {$APPTYPE CONSOLE}
- uses
- SysUtils;
- Type
- TArray = Array of Integer;
- Const
- DEFAULT_INPUT_FILE = './input.txt';
- DEFAULT_OUTPUT_FILE = './output.txt';
- PRINT_TYPE_MIN = 0;
- PRINT_TYPE_MAX = 2;
- SCAN_TYPE_MIN = 0;
- SCAN_TYPE_MAX = 1;
- ARRAY_LENGTH_MIN = 1;
- ARRAY_LENGTH_MAX = 1000;
- ARRAY_VALUES_MIN = -10000;
- ARRAY_VALUES_MAX = 10000;
- ERR_READ_INT_VALUE = $10000000;
- Function IsTextFile(Const FilePath: String): Boolean;
- Var
- IsTxt: Boolean;
- Len: Integer;
- Begin
- Len := Length(FilePath);
- IsTxt := ((Len > 2) And (FilePath[Len - 3] = '.') And (FilePath[Len - 2] = 't') And (FilePath[Len - 1] = 'x') And
- (FilePath[Len] = 't'));
- IsTextFile := IsTxt;
- End;
- Function CheckFileAvailability(Const FilePath: String; Const Read: Boolean): Boolean;
- Var
- IsAvailable: Boolean;
- Checkable: TextFile;
- Begin
- IsAvailable := True;
- AssignFile(Checkable, FilePath);
- Try
- If (Read) Then
- Reset(Checkable)
- Else
- Begin
- If (FileExists(FilePath)) Then
- Append(Checkable)
- Else
- Rewrite(Checkable);
- End;
- Close(Checkable);
- Except
- IsAvailable := False;
- End;
- If (IsAvailable And Not IsTextFile(FilePath)) Then
- IsAvailable := False;
- CheckFileAvailability := IsAvailable;
- End;
- Function TakeIntValueFromConsole(Const Description: String): Integer;
- Var
- Value: Integer;
- IsCorrect: Boolean;
- Begin
- IsCorrect := False;
- Value := 0;
- Repeat
- Write(Description);
- Try
- Readln(Value);
- IsCorrect := True;
- Except
- Writeln('Enter number, not string or anything else!');
- End;
- Until IsCorrect;
- TakeIntValueFromConsole := Value;
- End;
- Function TakeIntValueInRangeFromConsole(Const Description: String; Const Min: Integer; Const Max: Integer): Integer;
- Var
- Value: Integer;
- IsCorrect: Boolean;
- Begin
- Repeat
- Value := TakeIntValueFromConsole(Description);
- IsCorrect := True;
- If ((Value < Min) Or (Value > Max)) Then
- Begin
- Writeln('Value must be in range from ', Min, ' to ', Max, '!');
- IsCorrect := False;
- End;
- Until IsCorrect;
- TakeIntValueInRangeFromConsole := Value;
- End;
- Function TakeIntValueFromFile(Var FileToRead: TextFile): Integer;
- Var
- Value: Integer;
- Begin
- Try
- Read(FileToRead, Value);
- Except
- Value := ERR_READ_INT_VALUE;
- End;
- TakeIntValueFromFile := Value;
- End;
- Procedure TakeCorrectFile(Var FileToAssign: TextFile; Const Input: Boolean);
- Var
- FilePath, DefaultFilePath: String;
- IsCorrect: Boolean;
- Begin
- Repeat
- DefaultFilePath := DEFAULT_OUTPUT_FILE;
- If (Input) Then
- Begin
- Write('Enter path to input file (when empty - ', DEFAULT_INPUT_FILE, '): ');
- DefaultFilePath := DEFAULT_INPUT_FILE;
- End
- Else
- Write('Enter path to output file (when empty - ', DEFAULT_OUTPUT_FILE, '): ');
- ReadLn(FilePath);
- If (FilePath = '') Then
- FilePath := DefaultFilePath;
- IsCorrect := True;
- If (Not CheckFileAvailability(FilePath, Input)) Then
- Begin
- IsCorrect := False;
- WriteLn('This path contains wrong file or file, which cannot be accessed! Enter another path!');
- End;
- Until IsCorrect;
- AssignFile(FileToAssign, FilePath);
- If (Input) Then
- Reset(FileToAssign)
- Else
- Rewrite(FileToAssign);
- End;
- Procedure SortArray(Var Arr: TArray);
- Var
- Key, I, J, K: Integer;
- Begin
- Write('[');
- For K := 0 To Length(Arr) - 2 Do
- Write(Arr[K], ', ');
- WriteLn(Arr[Length(Arr) - 1], ']; i = 0');
- For I := 1 To Length(Arr) - 1 Do
- Begin
- Key := Arr[I];
- J := I - 1;
- While (J >= 0) And (Arr[J] > Key) Do
- Begin
- Arr[J + 1] := Arr[J];
- J := J - 1;
- End;
- Arr[J + 1] := Key;
- Write('[');
- For K := 0 To Length(Arr) - 2 Do
- Write(Arr[K], ', ');
- WriteLn(Arr[Length(Arr) - 1], ']; i = ', I);
- End;
- End;
- Function ReadArrayFromFile(): TArray;
- Var
- Arr: TArray;
- FileToRead: TextFile;
- IsCorrect: Boolean;
- I: Integer;
- Begin
- Repeat
- TakeCorrectFile(FileToRead, True);
- Var
- N := TakeIntValueFromFile(FileToRead);
- IsCorrect := True;
- If (N > (ARRAY_LENGTH_MIN - 1)) And (N < (ARRAY_LENGTH_MAX + 1)) Then
- Begin
- SetLength(Arr, N);
- For I := 0 To High(Arr) Do
- Begin
- Arr[I] := TakeIntValueFromFile(FileToRead);
- If (Arr[I] < ARRAY_VALUES_MIN) Or (Arr[I] > ARRAY_VALUES_MAX) Then
- IsCorrect := False;
- End;
- End
- Else
- Begin
- IsCorrect := False;
- If (N < ARRAY_LENGTH_MIN) Then
- WriteLn('Array cannot be smaller, than ', ARRAY_LENGTH_MIN, '!');
- If (N > ARRAY_LENGTH_MAX) Then
- WriteLn('Array cannot be bigger, than ', ARRAY_LENGTH_MAX, '!');
- End;
- If (N > (ARRAY_LENGTH_MIN - 1)) And (N < (ARRAY_LENGTH_MAX + 1)) And Not IsCorrect Then
- WriteLn('File contains wrong values!');
- Until IsCorrect;
- ReadArrayFromFile := Arr;
- End;
- Function ReadArrayFromConsole(): TArray;
- Var
- N, I: Integer;
- Arr: TArray;
- Begin
- N := TakeIntValueInRangeFromConsole('Enter length value for array (value must be in range from ' + IntToStr(ARRAY_LENGTH_MIN) + ' to ' +
- IntToStr(ARRAY_LENGTH_MAX) + '): ', ARRAY_LENGTH_MIN, ARRAY_LENGTH_MAX);
- SetLength(Arr, N);
- For I := 0 To High(Arr) Do
- Begin
- Arr[I] := TakeIntValueInRangeFromConsole('Array A element ' + IntToStr(I + 1) +
- ' (value must be in range from ' + IntToStr(ARRAY_VALUES_MIN) + ' to ' + IntToStr(ARRAY_VALUES_MAX) + '): ',
- ARRAY_VALUES_MIN, ARRAY_VALUES_MAX);
- End;
- ReadArrayFromConsole := Arr;
- End;
- Function ReadArray(): TArray;
- Var
- ReadType: Integer;
- Arr: TArray;
- Begin
- WriteLn;
- WriteLn('How to read values for calculations?');
- WriteLn('0 - From keyboard (console)');
- WriteLn('1 - From file');
- ReadType := TakeIntValueInRangeFromConsole('Enter read type: ', SCAN_TYPE_MIN, SCAN_TYPE_MAX);
- If (ReadType = 1) Then
- Arr := ReadArrayFromFile()
- Else
- Arr := ReadArrayFromConsole();
- ReadArray := Arr;
- End;
- Function SaveResultIntoFile(Const Arr: TArray): Boolean;
- Var
- Saved: Boolean;
- FileToSave: TextFile;
- I: Integer;
- Begin
- Saved := True;
- TakeCorrectFile(FileToSave, False);
- For I := 0 To Length(Arr) - 1 Do
- Begin
- Write(FileToSave, Arr[I]);
- Write(FileToSave, ' ');
- End;
- Close(FileToSave);
- SaveResultIntoFile := Saved;
- End;
- Procedure PrintResultIntoConsole(Const Arr: TArray);
- Var
- I: Integer;
- Begin
- WriteLn;
- WriteLn('Sorted array:');
- For I := 0 To Length(Arr) - 1 Do
- Begin
- Write(Arr[I]);
- Write(' ');
- End;
- WriteLn;
- End;
- Procedure PrintResult(Const Arr: TArray);
- Var
- WriteType: Integer;
- Saved: Boolean;
- Begin
- Saved := False;
- WriteLn;
- WriteLn('Where post result?');
- WriteLn('0 - Only into console');
- WriteLn('1 - Only into file');
- WriteLn('2 - Into console and into file');
- WriteType := TakeIntValueInRangeFromConsole('Enter write type: ', PRINT_TYPE_MIN, PRINT_TYPE_MAX);
- Case WriteType Of
- 0:
- Begin
- PrintResultIntoConsole(Arr);
- End;
- 1:
- Begin
- Saved := SaveResultIntoFile(Arr);
- End;
- 2:
- Begin
- Saved := SaveResultIntoFile(Arr);
- PrintResultIntoConsole(Arr);
- End;
- End;
- If (Saved) Then
- WriteLn('Result saved into file!');
- End;
- Begin
- Var Arr: TArray;
- WriteLn('3. Sorting by simple insertion method.');
- Arr := ReadArray();
- SortArray(Arr);
- PrintResult(Arr);
- WriteLn('Press [ENTER] to close program...');
- ReadLn;
- End.
Advertisement
Add Comment
Please, Sign In to add comment