Процедура на стринги !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!

[klem4]

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

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;

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

[Alex7]

klem4, понятно, но зачем ты делаешь

Код

i := back;

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

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

[volvo]

    {$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)

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

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