Процедура на стринги !eror!, помогите найти ошибку... Опции

[Alex7]

Сделал програмку. все работает правильно, не считая, того, что зависает почему-то! в чем дело?
Задание:

Код

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

Вот прога:

Program DeleteWord;
Uses    CRT;
Var     f1,f2: text;
        f1name,f2name,st: string;
        s,s1: char;

Procedure delword(Var st:string; s:char);
Const delimiter=[' ',',','.','?','!','(',')','/'];
Var i: byte;
begin
 If s in [#65..#90] then s1:=Chr(Ord(s)+32) else s1:=Upcase(s);
 i:=1;
 While i<=length(st) do
    If (i=1) and ((st[i]=s)or(st[i]=s1)) then
     Repeat delete(st,i,1) Until st[i] in delimiter else
     If (st[i] in delimiter) and ((st[i+1]=s)or(st[i+1]=s1)) then
      Repeat delete(st,i+1,1) Until st[i+1] in delimiter else
       Inc(i)
   {If (i=1) and (st[i]=s) then delete(st,i,Pos(' ',st)-i) else
     If (st[i]=' ') and (st[i+1]=s) then delete(st,i,Pos(' ',st)-i) else
      Inc(i)}
end;

Begin
 clrscr;
 Repeat
     Writeln('Введите имя файла'); readln(f1name);
     assign(f1,f1name);
     {$I-}
     reset(f1);
     {$I+}
     if IOResult<>0 then
      writeln('Неверно!!');
 Until IOResult=0;
 f2name:='new'+f1name;
 assign(f2,f2name); rewrite(f2);
 Writeln('Введите букву'); readln(s);
 While not EOF(f1) do
    begin
       readln(f1,st);
       delword(st,s);
       writeln(f2,st);
    end;
 Writeln('Текст, без слов с 1-й буквой"',s,'" или "',s1,'") занесен в (',f2name,')');
 close(f1);
 close(f2);
 Readln;
End.

Пример тхт:

Welcome to BPL70N15.ZIP, a collection of fast replacement libraries
for your Turbo Pascal 7.0 / Borland Pascal 7.0 compiler. There are
three libraries in this package, a real mode library (TURBO.TPL), a
DOS protected mode library (TPP.TPL), and a Windows library (TPW.TPL).
Every file is a complete, replacement for the original library bearing,
the same name that came with your Pascal compiler. Due to the many
optimizations in the replacement libraries, many programs compiled
with these libraries will run faster. For more detailed information
on possible performance improvements, see the file PERFORM.DOC. Only
performance information for real mode and DOS protected mode programs
can be provided at the moment!

[volvo]

Не знаю, у меня ничего не виснет (я просто не занимаюсь изобретением велосипедов, код взят из той же самой прикрепленной темы: Разбиение на слова. Все способы):

uses crt;

procedure del_words(var s: string; ch: char);
const
  delimiter = [#32, ',', '.', '!', ':'];
  max_word = 255;
type
  wrd_info = record
    start, len: byte;
  end;

var
  count: integer;

  i, curr_len: byte;
  words: array[0 .. pred(max_word)] of wrd_info;

begin
  count := -1; i := 1;
  while i <= length(s) do begin

    while (s[i] in delimiter) and (i <= length(s)) do inc(i);

    curr_len := 0;
    while not (s[i] in delimiter) and (i <= length(s)) do begin
      inc(i); inc(curr_len);
    end;

    if curr_len > 0 then begin
      inc(count);
      with words[count] do begin
        start := i - curr_len;
        len := curr_len
      end;
    end;

  end;

  for i := count downto 0 do
    if upcase(s[words[i].start]) = upcase(ch) then
      delete(s, words[i].start, words[i].len);
end;


var
  f1, f2: text;
  f1name, f2name, st: string;
  is_ok: boolean;
  s: char;

begin
  clrscr;
  repeat
    write('filename: '); readln(f1name);
    assign(f1,f1name);
    {$I-} reset(f1); {$I+}
    is_ok := (IoResult = 0);

    if not is_ok then writeln('Error !');
  until is_ok;

  f2name := 'new'+f1name;
  assign(f2,f2name); rewrite(f2);
 
  write('char: '); readln(s);
  while not eof(f1) do begin
    readln(f1, st);
    del_words(st, s);
    writeln(f2, st);
  end;
  readln;
end.

(в txt файле последняя строка должна быть пустая...)

Кстати, у тебя есть недочет:
IoResult после первого обращения к нему сбрасывается, так что у тебя Repeat ... Until будет работать неверно в случае ошибки... Нужно запоминать, была ли ошибка, и потом обрабатывать ее...