слова содержащие

Ответ от
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
var s:string;
f,t:text;
function preobr(s:string):string;
var i,j,p,n,k,o,sered,p2:integer;
gl,zp,slovo,pol,s2:string;
m:array [1..1000] of string;
begin
zp:='!?*,.';
p:=pos(' ',s);
i:=0;
repeat
inc(i);
slovo:=copy(s,1,p-1);
m[i]:=slovo;
delete(s,1,p);
p:=pos(' ',s);
until p=0;
n:=i+1;
m[n]:=s;
for i:=1 to n-1 do begin
for j:=i+1 to n do
s:=m[i];
s2:=m[j];
if pos(s[length(s)],zp)<>0 then p:=length(s)-1 else p:=length(s);
if pos(s2[length(s2)],zp)<>0 then p2:=length(s2) else p2:=length(s2);
sered:=(p2 div 2)+1;
pol:=copy(s2,1,sered);
if p>=6 then begin
if pos(pol,m[i])=1 then
for k:=1 to length(s) do begin
s[k]:=UpCase(s[k]);
m[i]:=s+'('+s[k]+')';
end;
end;
end;
s:='';
for i:=1 to n do s:=s+m[i]+' ';
preobr:=s;
end;
begin
assign(f,'input.txt'); reset(f);
assign(t,'output.txt'); rewrite(t);
while not eof(f) do
begin
readln(f,s);
writeln(t, preobr(s) );
end;
writeln('Файл успешно записан.. ');
close(f);
close(t);
readln;
end.