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

Вот прога:

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.

Пример тхт:

я бы процедуру писал вот так :

procedure DelWords(var s : string; ch : char);
const  limits = [#0..#32,'.',','];
var
   i,back : byte;
begin
   i := 1;
   while(i <= length(s)) do begin
      while(i <= length(s)) and (s[i] in limits) do inc(i);

      if (i <= length(s))  then begin
         back := i;
         while(i <= length(s)) and not(s[i] in limits) do inc(i);
         if s[back] = ch then begin
            delete(s, back, i-back);
            i := back;
         end;
      end;
   end;
end;

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

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 будет работать неверно в случае ошибки... Нужно запоминать, была ли ошибка, и потом обрабатывать ее...

klem4, понятно, но зачем ты делаешь (15-я строка) если при удалении i и так уменьшится до back ?
ЗЫ: если честно.... запутано...
volvo, тоже ясно, но зачем ведь так сложно.... через записи , масивы....
Я, знаете ли, люблю велосипеды... но изобретать их видимо взялся зря. Но и писать такую процедуру, опятьтаки же огромную, по сравнению с самой прогой....

На счет Ioresult разобрался. Это меня препод неправильно исправил, у меня там было запоминание.... Кстати. она ж даже и так работать не будет, т.к. перед ней стоит writeln, а он будет давать '0' ведь ioresult- "проверка" ввода\вывода?

    {$I-} reset(f1); {$I+}
    is_ok := (IoResult = 0);

Reset производился НЕПОСРЕДСТВЕННО перед превым обращением к IoResult, поэтому IoResult так работать будет, но если ты попытаешься:

    {$I-} reset(f1); {$I+}
    is_ok := (IoResult = 0);
    writeln(IoResult);

то это уже выдаст неверный результат (обращение к IoResult уже было, и он обнулился)...

А насчет этого:
Ты меня извини, но ты забыл (если вообще когда-то знал) основную заповедь программиста: точнее их 2...
1) код, написанный один раз должен быть ReUsable, то есть ты его с легкостью должен преобразовывать для любых других похожих задач... Ты свой код преобразовать сможешь? Я, как видишь, то что приведено по ссылке уже как минимум в 20 местах использовал практически без изменений. А ты все гонишься за простотой программы, а получается - неспособность ее отлаживать и вносить минимальные изменения...
2)

Делай выводы.