Помогите пожалуйста со строками в Pascal

[ma3a]

Помогите пожалуйста со строками в Pascal

Дана символьная строка. Слово - последовательность символов между пробелами, не содержащая пробелы внутри себя. Отредактировать строку, удалив из него слова, которые встречаются в предложении заданное число раз. Результат вывести на экран и в текстовый файл.

 

[Vladimir_S]

Дана символьная строка. Слово - последовательность символов между пробелами, не содержащая пробелы внутри себя. Отредактировать строку, удалив из него слова, которые встречаются в предложении заданное число раз. Результат вывести на экран и в текстовый файл.

Пожалуйста (имя и расположение файла можете, естественно, поменять):

VAR
 S:String;
 i,j,Nw,i1,i2,Nt,Nw1:Integer;
 W,W1:Array[1..128] of String;
 times:Array[1..128] of Byte;
 b:Boolean;
 f:text;

BEGIN
 { [COLOR=Red]Ввод строки[/COLOR] } 
 WriteLn('Enter the string:');
 ReadLn(S);

{ [COLOR=Red]Разбиение строки на слова; слова формируют массив W[/COLOR] } 
 i:=0;
 Nw:=0;
 Repeat
  Repeat
   Inc(i);
  Until S[i]<>' ';
  i1:=i;
  While (S[i]<>' ') and (i<Length(S)) do
   Inc(i);
  If i=Length(S) then i2:=i else i2:=i-1;
  Inc(Nw);
  W[Nw]:=Copy(S,i1,i2-i1+1);
 Until i=Length(S);

{ [COLOR=Red]Ввод количества повторений[/COLOR] } 
 Write('How many times? ');
 ReadLn(Nt);

{ [COLOR=Red]Формирование массивов W1 и times; первый содержит перечень слов,
 входящих в строку, БЕЗ ПОВТОРОВ, а второй - количество повторов 
каждого из слов в исходной строке[/COLOR] } 
 Nw1:=0;
 For i:=1 to Nw do
  begin
   b:=true;
   for j:=1 to i-1 do
    if W[j]=W[i] then b:=false;
   If b then
    begin
     Inc(Nw1);
     W1[Nw1]:=W[i];
     times[Nw1]:=0;
     for j:=i to Nw do
      if W[j]=W1[Nw1] then Inc(times[Nw1]);
    end;
  end;

{ [COLOR=Red]Открытие файла для записи[/COLOR] } 
 Assign(f,'D:\Out.txt');
 ReWrite(f);
 Writeln(f,S);

{ [COLOR=Red]Вывод на экран и в файл слов исходной строки, не повторяющихся 
заданное количество раз[/COLOR] } 
 For i:=1 to Nw do
  begin
   b:=true;
   for j:=1 to Nw1 do
    if (W[i]=W1[j]) and (times[j]=Nt) then b:=false;
   If b then
    if i<Nw then
     begin
      Write(W[i]+' ');
      Write(f,W[i]+' ');
     end
    else
     begin
      Write(W[i]);
      Write(f,W[i]);
     end;
  end;

 Writeln;
 Writeln(f);
 Close(f);
 Readln
END.