uses crt var str firstWord word string integer -------------------- --

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
uses crt;
var str,firstWord,word:string;
i,k:integer;
{------------------------------------------------------------}
function trim(str:string):string;
begin
while pos(' ',str) <> 0 do
delete(str,pos(' ',str),1);
trim:=str;
end;
{------------------------------------------------------------}
function countWords(str:string):integer;
var k,i:integer;
begin
k:=0;
for i:=1 to length(str) do
if (str[i] <> ' ') and ((str[i+1] = ' ') or (str[i+1] = '.')) then
k:=k+1;
countWords:=k;
end;
{------------------------------------------------------------}
function getFirstWord(str:string):string;
var i:integer;
begin
i:=1;
repeat
i:=i+1;
until str[i] = ' ';
getFirstWord:=copy(str,1,i-1);
end;
{------------------------------------------------------------}
function isSort(str:string):boolean;
var b:boolean;
i:integer;
begin
b:=true;
i:=1;
while (i <= length(str)-1) and b do
begin
if str[i] > str[i+1] then b:=false;
i:=i+1;
end;
isSort:=b;
end;
{------------------------------------------------------------}
procedure task2(str:string);
var words: set of char;
i,j,k:integer;
ch:char;
begin
words:=[];
for i:=1 to length(str) do
begin
k:=1;
for j:=i+1 to length(str) do
if str[i] = str[j] then
k:=k+1;
if k > 1 then
begin
if str[i] in words then
else words:=words+[str[i]];
end;
end;
for ch:='a' to 'z' do
if ch in words then
write(ch:2);
end;
{------------------------------------------------------------}
begin
clrscr;
writeln('Enter the string');
readln(str);
{delete spaces}
str:=trim(str);
firstWord:=getFirstWord(str);
if(str[length(str)] <> '.') then str:=str+'.';
if(countWords(str) > 2) and
(countWords(str) < 50) then
begin
i:=1;
repeat
k:=1;
while ((i<=length(str)) and (str[i] <> ' ') and (str[i] <> '.')) do
begin
i:=i+1;
k:=k+1;
end;
word:=copy(str,i-(k-1),k-1);
if ((length(word) > 1) and (length(word) < 8)) then
if(word <> firstWord) then
if not isSort(word) then
writeln(word);
i:=i+1;
until i>length(str);
end
else writeln('Count words does not match');
readkey;
writeln('Task 2');
task2(str);
readkey;
end.