[Asira]

Код:

{$APPTYPE CONSOLE}

uses
  SysUtils;

var str, slovo: string;
       ks, ns, i, j: integer;
       sb,mn1, mn2, mn3, mn4: set of char;
       c, a: char;

begin
   mn1:=[]; mn2:=[]; mn4:=[];
   sb:=['b','d','g','j','n','m','r','v','z','w'];
   readln (str);
   i:=1;
   while i<=length (str) do
     begin
        while (str[i]=' ')
        //and (i<=length (str))
        do i:=i+1;
        ns:=i;
        while (str[i]<>' ')
        //and (i<=length (str))
         do i:=i+1;
        ks:=i;
        slovo:= copy(str, ns, ks-ns);
        for j:=1 to length(slovo) do mn1:=[slovo[j]];
        mn4:=sb -mn1;
          for c:=chr(0) to chr (255) do
   if c in mn4 then write (c,' ');
 writeln(' ');
        end;
begin
i:=length(str);;
while (str[i]=' ')
 ///and (i<=length (str))
  do i:=i-1;
        ks:=i;
        while (str[i]<>' ')
        //and (i<=length (str))
         do i:=i-1;
        ns:=i;
        slovo:= copy(str, ns, ks-ns);
for j:=1 to length (slovo) do mn3:=[slovo[j]];
       mn1:=[];
mn1:=mn4 - mn3;
  for c:=chr(0) to chr (255) do
   if c in mn4 then write (c,' ') end;
while i<=length (str) do
begin
      while (str[i]=' ') and (i<=length (str)) do i:=i+1;
        ns:=i;
        while (str[i]<>' ') and (i<=length (str)) do i:=i+1;
        ks:=i;
        slovo:= copy(str, ns, ks-ns);
for j:=1 to length(slovo) do mn2:=mn2+[slovo[j]];
mn3:=mn2*mn1;
for c:=chr(0) to chr (255) do
   if c in mn3 then write (c,' ');
   writeln(' ');
   readln;
   end;
end.

[Asinkrit]

Я же тебе уже давал код для решения этой задачи?

Код:

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  S, NewS:String;
  b:byte;
  sb: set of char;

begin
  Writeln('Enter string ');
  Readln(S);
  sb:=['b','d','g','j','n','m','r','v','z','w'];
  for b:=1 to Pos(' ', S) do
    if S[b] in sb then
      sb:=sb-[S[b]];
  Delete(S, 1, Pos(' ', S));
  b:=length(s);
  while (b > 1) and (S[b]<>' ') do
    begin
    if S[b] in sb then
      sb:=sb-[S[b]];
    Dec(b); 
    end;
  Delete(S, b, Length(S)-(b+1));
  for b:=1 to Length(S) do
    if S[b] in sb then
      begin
      sb:=sb-[S[b]];
      write(S[b],' ');
      end;
  readln;
end.

[Asira]

Мне сказали надо первое и последнее слово запихать во множество а потом работать со множествами без строк

[Asinkrit]

Держи)

Код:

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  S:String;
  b:byte;
  sb, nsb, rsb: set of char;
  zBegin, zEnd:Byte;
  c:char;

begin
  Writeln('Enter string ');
  Readln(S);
  sb:=['b','d','g','j','n','m','r','v','z','w']; //символы которые ищем
  nsb:=[];  //символы которые в первом и последнем слове
  rsb:=[];  //символы которые будем выводить на экран
  //сначала пробежимся по первому и последнему слову, и соберем nsb
  zBegin:=Pos(' ', S);
  for b:=1 to zBegin do
    if S[b] in sb then
      nsb:=nsb+[S[b]];
  b:=length(s);
  while (b > 1) and (S[b]<>' ') do
    begin
    if S[b] in sb then
      nsb:=nsb+[S[b]];
    Dec(b);
    end;
  zEnd:=(b+1);
  //теперь пробежимся по остальным словам и соберем rsb
  for b:=zBegin to zEnd do
    if (S[b] in sb) then
      rsb:=rsb+[S[b]];
  //вычтем из rsb символы nsb
  rsb:=rsb-nsb;
  //и выведем результат
  for c:=chr(0) to chr (255) do
    if c in rsb then
      write(c,' ');
  readln;
end.

[Asira]

Спасибо!..............