Задача с символами

[pasha1993]

Народ, помогите подправить программу. Пишет ошибку на 25 строчке.

uses crt;
const sg=['b','c','d','f','g','h','j','k','l','m','n','p','q','r','s','t','v','w','x','z'];{soglasnie}
ds=['a'..'z',','];{dopystimie dl'a vvoda}
type mnoz=set of char;
{procedyra sozndania mnochestva iz stroki simvolov}
procedure Mnozhestvo(s:string;var m:mnoz);
var i:byte;
begin
m:=[];
for i:=1 to length(s) do
if s[i] in sg then m:=m+[s[i]];
end;
var s,s1:string;
c:char;
m,m1,mi:mnoz;
i,j,k,z:byte;
begin
clrscr;
writeln('Vvedite posledovatelnost slov iz strochnih latinskih');
writeln('Razdelennih zapatimi, vkonce tochka');
{Vvodim simvoli, dopystimie zapisivaem v stroky}
s:='';
repeat
read(c)
until c in ds then s:=s+c;
until c='.';
readln ('Posle vvoda schmem enter');
writeln(s);{Vivodim stroky dl'a proverki}
s:=s+','; {dobavim zap'atyu v konec}
{ydalim lishnie zap'atie, esli vveli dve podr'at}
while pos(',,',s)>0 do
delete(s, pos(',,',s),1);
{sozdadim mnochestvo vseh soglasnih, kotorie est' v stroke}
m:=[];
for i:=1 to length(s) do
if s[i] in sg then m:=m+[s[i]];
{sozdadim mnochestvo soglasnih v pervom (nechetnov) slove}
s1:=copy(s,1,pos(',',s));
Mnochestvo(s1,m1);
delete(s,1,pos(',',s));
i:=1
while pos(',',s)>0 do {poka est' zap'atie}
 begin
  s1:=copy(s,1,pos(',',s));{kopiryem ocherednoe pervoe chislo}
  i:=i+1; {schitaem}
  Mnozestvo(s1,mi);{sozdaem mnochestvo}
  if i mod 2<>0 then m1:=m1*mi;{esli nechetnoe slovo, delaem peresechenie mnochestv - obshie bykvi}
  delete(s,1,pos(',',s));{Ydal'aem proverennoe slovo, sledyushee slovo}
 end;
if m1=[] then
 begin
 write('Ykazanih po ysloviu bykv net!');
   readln;
  exit;
 end;
 writeln('Mnochestvo ykazanih po ysloviu bykv:');
for c:='b' to 'z' do {kodi}
if c in m1 then write(c,' ');
readln
  exit;
 end.

[Don Karleone]

вы бы хоть написали, что она делать должна.
А вообще у цикла
repeat
read(c)
until c in ds then s:=s+c;
ветки then не бывает.

m:=[]; - ?????

Ее проще заново написать, чем подправлять.

[pasha1993]

Дана непустая последовательность слов из строчных латинских букв; между соседними словами - запятая, за последним словом - точка. Напечатать в алфавитном порядке все согласные буквы, которые входят в каждое нечетное слово.

[Don Karleone]

readln(str);
  Count:=0;
  while pos(',',str) <> 0 do
      begin
          s:=copy(str,1,pos(',',str) - 1);
          Inc(Count);
          if odd(Count) then // ищем согласные в слове
          Delete(str,1,pos(',',str));
      end;
  Inc(Count);
  if odd(Count) then  // ищем согласные в слове

согласные можно наращивать во вспомогательной строке, например ST. Как-то так, или можно придумать что-нибудь по оригенальнее (или по проще):

for i:=1 to Length(s) do
    if (s[i]<>'a')and(s[i]<>'e')and(s[i]<>'i')
       and(s[i]<>'j')and(s[i]<>'o')and(s[i]<>'u') then ST:=ST + s[i];

потом эту строку надо отсортировать по алфавиту.

[pasha1993]

Да реально придется переписывать

[WhiteSpirit]

Попробуй вот так:

var
  nc: Boolean;
  Letters: set of Char;
  str: String;
  p: Integer;
  c: Char;

begin
ReadLn(str);
p:=1;
nc:=True;
while p < Length(str) + 1 do begin
    Letters:=[];
    while (str[p] <> ',') and (p < Length(str) + 1) do begin
        if nc then
            if [str[p]] * ['a'..'z'] - ['e', 'y', 'u', 'i', 'o', 'a'] <> [] then Include(Letters, str[p]);
        Inc(p);
        end;
    Inc(p);
    nc:=not nc;
    if not nc then WriteLn;
    for c:='a' to 'z' do if c in Letters then Write(c);
    end;
Readln;

end.

Только это написано в Delphi, будет ли работать в турбо паскале - неизвестно