klasscho

Untitled

Feb 16th, 2020
153
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.01 KB | None | 0 0
  1. program Project17;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. {$R *.res}
  6.  
  7. uses
  8. System.SysUtils;
  9.  
  10. procedure ReadFileName(var MyFile: TextFile);
  11. var
  12. FName: string;
  13. CorrectName: Boolean;
  14. begin
  15. Writeln('Enter a file name for data entry in the format Name.txt');
  16. repeat
  17. Readln(FName);
  18. if FileExists(FName) then
  19. CorrectName := True
  20. else
  21. begin
  22. Writeln('The file name was entered incorrectly. Try again. Example: Name.txt');
  23. CorrectName := False;
  24. end;
  25. until CorrectName;
  26. AssignFile(MyFile, FName);
  27. Reset(MyFile);
  28. end;
  29.  
  30. function FileCheck(var Words: String) : Boolean;
  31. var
  32. FName: String;
  33. IsCorrect: Boolean;
  34. InputFile: TextFile;
  35. TrueString, IsValidInput: Boolean;
  36. begin
  37. Assign(InputFile, FName);
  38. Reset(InputFile);
  39. TrueString := True;
  40. while not EOF (Inputfile) do
  41. begin
  42. try
  43. Read(InPutFile, Words);
  44. except
  45. TrueString := False;
  46. end;
  47. end;
  48. if Eof(InputFile) then
  49. IsValidInput := True
  50. else
  51. Writeln('File is empty.');
  52. Reset(InputFile);
  53. Writeln(Words);
  54. FileCheck := TrueString;
  55. end;
  56. procedure LongestWord(var Words: String);
  57. Var
  58. i, j, k, Max: Integer;
  59. Line: String;
  60. begin
  61. i := 1;
  62. Max := 0;
  63. repeat;
  64. j := 0;
  65. While (Words[i] <> ' ') and (i <= length(Words)) do
  66. begin
  67. Inc(i);
  68. Inc(j);
  69. end;
  70. if j > Max then
  71. Max := j;
  72. Inc(i);
  73. until i > length(Words);
  74. Writeln(Max);
  75. i := 1;
  76. repeat;
  77. j := 0;
  78. while (Words[i] <> ' ') and (i <= length(Words)) Do Begin
  79. Line := Line + Words[i];
  80. Inc(i);
  81. end;
  82. if length(Line) = Max then
  83. Writeln(Line);
  84. Line := '';
  85. Inc(i);
  86. until i > length(Words);
  87. end;
  88.  
  89. procedure ReadFileOutputName(var MyFile: TextFile);
  90. var
  91. NewFName: string;
  92. CorrectName: Boolean;
  93. begin
  94. Writeln('Enter a file name for data entry in the format Name.txt');
  95. repeat
  96. Readln(NewFName);
  97. if Copy(NewFName, length(NewFName) - 3, 4) = '.txt' then
  98. CorrectName := True
  99. else
  100. begin
  101. Writeln('The file name was entered incorrectly. Try again. Example: Name.txt');
  102. CorrectName := False;
  103. end;
  104. until CorrectName;
  105. AssignFile(MyFile, NewFName);
  106. Rewrite(MyFile);
  107. end;
  108.  
  109. procedure WriteToFile();
  110. var
  111. LongWord: String;
  112. FName: String;
  113. OutFile: Text;
  114. begin
  115. Assign(OutFile, FName);
  116. Rewrite(OutFile);
  117. Writeln(OutFile, 'The longesr word or words:' + LongWord);
  118. Close(OutFile);
  119. end;
  120.  
  121. var
  122. Words: String;
  123. MyFile: TextFile;
  124. CorrectFile : Boolean;
  125. begin
  126. Writeln('This program finds the longest word in the string.');
  127. ReadFileName(MyFile);
  128. CorrectFile := FileCheck(Words);
  129. Writeln('Your string: ');
  130. Writeln(Words);
  131. Writeln('');
  132. Writeln('The longest word or several words:');
  133. LongestWord(Words);
  134. ReadFileOutputName(MyFile);
  135. WriteToFile();
  136. Readln;
  137. end.
Advertisement
Add Comment
Please, Sign In to add comment