Обработка текстов Опции

[Amigos3210]

Помогите пожалуйста найти ошибку в коде. Задание следующее:

Обработка текстов.
Задан текст, состоящий из строк произвольной длины. Строки разделяются одним или несколькими символами, называемыми разделителями. Разделители одинаковы для всего текста. Текст заканчивается комбинацией двух специальных символов, отличных от разделителя.
Выполнить над текстом последовательность действий, указанную в задании.

а) Определить порядковые номера, считая от начала текста, определенных слогов, которые задаются в исходных данных;
б) сформировать новый текст, в котором каждый такой слог заключен в кавычки.

program strings;
uses
    crt;
const
     n = 20;	{Максимальное количество строк, читаемое из файла}
var
   fin,fout : Text;		{Входной и выходной файлы}
   s : array [1..n] of string; {Текст - массив строк}
   substr : string;		{Искомый слог - подстрока}
   i,c,k,p : integer;
begin
     clrscr;
     assign(fin,'input.txt'); {Открываем входной файл}
     reset(fin);
     assign(fout,'output.txt'); {Открываем выходной файл}
     rewrite(fout);
     k:=0; {Количество строк во входном файле}
     while (not eof(fin) and (k<n)) do
           begin
                k:=k+1;
                readln(fin,s[k]); {Записываем содержимое файла в массив строк}
           end;
     if k = 0 then writeln('Error: file is empty'); {На всякий случай, если входной файл - пустой}

     for i:=1 to k do writeln(s[i]); {Выводим на экран содержимое массива}

     writeln('Enter substring to search:');
     readln(substr);
     p:=0; {Переменная для хранения текущей позиции искомой подстроки, если не найдено подстроки = 0}
     i:=1; {Итератор}
     c:=0; {Курсор относительно текста, нужен чтобы получать абсолютную позицию подстроки}
     repeat
           begin
                p:=pos(substr,s[i]);
                i:=i+1;
           end
     until (p>0) or (i>k); {Проверяем, содержится ли подстрока вообще в тексте}

     if p = 0 then
        begin
             writeln('Error: no substring founded.'); {Если подстроки нет, выводим сообщение}
             for i:=1 to k do writeln(fout,s[i]); {И переписываем содержимое массива в выходной файл}
        end
     else	{Если подстрока содержится в тексте}
         for i:=1 to k do
             begin
                  p:=pos(substr,s[i]);
                  if p = 0 then {Проверяем, содержится ли она в i-ой строке}
                     begin
                          writeln(fout,s[i]); {Если нет, то просто переписываем строку в выходной файл}
                          c:=c+length(s[i]); {Передвигаем курсор на длину строки}
                     end
                  else 
                      begin
                           while p>0 do {Если содержится, то в цикле по всем вхождениям подстроки...}
                                 begin
                                      write(fout,copy(s[i],1,p-1)+'"'+substr+'"'); {записываем в файл начало строки и подстроку в кавычках}
                                      write(c+p,' '); {выводим на экран абсолютную позицию}
                                      c:=c+p+length(substr); {сдвигаем курсор}
                                      delete(s[i],1,p+length(substr)-1); {удаляем из исходной строки начало и подстроку}
                                      p:=pos(substr,s[i]); {ищем новое вхождение подстроки в строке}
                                 end;
                           writeln(fout,s[i]); {дописываем оставшийся кусок строки}
                      end;
             end;
     repeat until keypressed;
     close(fin); {закрываем файлы}
     close(fout); 
end.

смущает то, что ведется несколько кривой подсчет порядковых номеров заданного слога.
Заранее благодарен, если кого-то не затруднит.

М

Теги! Правила Форума, п.5, и правила раздела Задачи, п.2. Исправлено. - Lapp