Ввести две строки, изъять из первой строки все слова, которые встречаются во второй. Программа написана с помощью процедур — Pascal(Паскаль)

program strings;
  uses crt;
  var
     S1,S2,S3:string;
     key:char;
     flag:boolean;
     t:byte;

  procedure about;
   var i: byte;
   begin textcolor(15);

   begin textcolor(15);
   for i:=1 to 80 do write(chr(196));
   end;  textcolor(13);
   writeln('     Task: From first string del all words that were found in second sring.');
   begin                textcolor(15);
   for i:=1 to 80 do write(chr(196));
   end;
   end;

  function words:string;
    var w,w1,l:string; b,i:byte;
     begin
      w1:='';
  repeat
    i:=random(16);
     case i of
      1:w:='absolute';       9:w:='not';
      2:w:='begin';          10:w:='packed';
      3:w:=' ';    11:w:='writeln';
      4:w:='not';            12:w:='uses';
      5:w:='external';       13:w:='MunCHkin';
      6:w:='function';       14:w:='FIOT';
      7:w:='uses';           0:w:='IS21';
      8:w:='label';          15:w:='  ';
     end;
       if (length(w1)+length(w))<78
        then
        begin
          w1:=w1+w+' '; l:=w1;
          end
        else break;

     until false;
{     b:=length(l);
     repeat
     begin
     if l[b-1]=' ' then delete(l,b,1);
     b:=length(l);
           end;
           until l[b-1]<>' '; }
     words:=l;
      end;




   procedure rwords(flag:boolean;var r:string);
     begin
      if flag=false
      then
       begin
        textcolor(10);
         writeln('                               1st string:');
          writeln; textcolor(15);
           r:=words;
            writeln(' ',r);

       end

       else if flag=true then
        begin
         writeln; textcolor(10);
          writeln('                               2nd string:');
           textcolor(15);
            writeln;
             r:=words;
              writeln(' ',r);
        end;
     end;

  procedure calc(m,n:string);
     var max,i,f,b  :integer;
         q,rez,l  :string;

  begin
     q:='';
     while m[1]=' ' do delete(m,1,1);
     n:=' '+n; m:=m+' ';

          begin

           repeat
           m:=m+' ';
                   while m[1]=' ' do delete(m,1,1);
            max:=pos(' ',m)-1;
            rez:=copy(m,1,max);
            if pos(rez+' ',n)<>0 then
               begin
                   while pos(rez+' ',m)<>0 do

                   delete(m,pos(rez+' ',m),max+1);
               end
                                 else
                       begin
                          q:=q+copy(m,1,max)+' ';
                          delete(m,pos(rez+' ',m),max+1);
                       end;
                 repeat
                b:=length(m);
              if m[b]=' ' then   delete(m,b,1);
               until m[b]<>' ';

      until  m=''
     end;
     writeln; textcolor(10);
     writeln('                             New 1st string:');
     textcolor(15);
      writeln;
     writeln(' ',q);
     end;




       begin {basic program}
  repeat
    randomize;
    clrscr;
    about;
      begin
       rwords(false,s1);
       rwords(true,s2);
       calc(s1,s2);
      end;
   writeln;writeln;writeln;writeln;
   writeln; writeln;
   writeln;
   writeln;
   write(' Pres Enter to continue or Esc to end: ');
   key:=readkey;
   until key=#27;
   end. {end of basic program}