Код:
program zd;
const gluh = ['к', 'п', 'с', 'т', 'ф', 'х', 'ц', 'щ']; {Все глухие}
type wrds = array[1..250] of string; {новый тип- массив словес}
var l: string; {строчечго}
ww: array[1..250] of string; {массив слов}
len, ii: integer; {числеца - len кол-во слов ii счётчик}
procedure fromstringtwords; {строчечго --> словеса}
var i, j: integer; { no comments}
cs: string; {cs- current string - кусок слова}
begin {---}
i := 1; {---}
j := 1; {---}
cs := ''; {}
while l[i] <> '.' do {пока символ l[i] <> '.'}
begin {---}
if l[i] = ',' then {если он "," }
begin {---}
ww[j] := cs; {словесо = сs}
cs := ''; {кусок слова пустой}
inc(j); {следующее словесо }
end else cs := cs + l[i]; {иначе кусок слова + символ из строчечго}
inc(i);
end;
ww[j] := cs; {последнее словесо}
len := j; {кол-во словес}
end;
function ninchet(s: char): boolean; {символ s не содержится в 1 чёт.}
var i, j: integer;
k: boolean;
begin
i := 0;
k := true; {к = содержится}
while (i <= len) and k do
begin
inc(i, 2);
j := 1;
while (j <= length(ww[i])) and (ww[i][j] <> s) do inc(j);
if j <= length(ww[i]) then {если всё-таки не содержится}
begin
k := false; {то так и быть}
end;
end;
ninchet := i > len; {возврат}
end;
function inallnechet(s: char): boolean; {во всех нечет. есть s}
var i, j: integer;
k: boolean;
begin
k := true; {k= оно во всех}
i := -1;
while (i <= len) and k do { если не во всех- ПАКА}
begin
inc(i, 2);
j := 1;
while (j <= length(ww[i])) and (ww[i][j] <> s) do inc(j);
k := j > length(ww[i]); {k:= во всех ли?}
end;
inallnechet := i < len;
end;
var jj: integer;
begin
fillchar(ww, sizeof(ww), 0); {забить словеса пустотой}
{ read(l);}{строчечго!}
l := 'хищение,ага,порох.';
fromstringtwords; {строчечго --> словеса}
WriteLn(len);
for jj := 1 to Len do
Writeln(ww[jj]);
for ii := 40 to 256 do {все символы, в кот. может содержаться глух. (можно упростить)}
if chr(ii) in gluh then {если символ глухой}
begin
if ninchet(chr(ii)) and inallnechet(chr(ii)) then write(chr(ii), ' '); { и соотв. условию - вывести}
end;
end. {всё}
прога.7z