помогите исправить задачку

[innaa639]

Вот задача: Ввести строка символов, которая содержит слова и эталонное слово. Найти в строке все слова, из которых можно получить эталонное слово в результате одной ошибки.
Вот код, но здесь что-то не правильно, как ее проверить?Скажите чего исправить

const
rzd = [',', '-', '.'];
var
slovo, etalon, st: string;
i, j, k: byte;
begin
write('st = ');
readln(st);
write('etanol = ');
readln(etalon);
st := ' ' + st + ' ';
for i := 1 to length(st) do
if st[i] in rzd then st[i] := ' ';
while pos(' ', st) > 0 do delete(st, pos(' ', st), 1);
delete(st, 1, 1);
repeat
i := pos(' ', st);
slovo := copy(st, 1, i - 1);
j := 0;
if abs(length(slovo) - length(etalon)) <= 1 then
for i := 1 to length (slovo) do
if slovo[i] <> etalon[i] then inc(j);
if j = 1 then writeln(slovo);//одна ошибка обязательна
delete(st, 1, i)
until st = '';
readln
end.

[alex_fcsm]

uses crt;
var s,sub:string;
    i,j,n,m:integer;
    a:array[1..10] of string;

begin
clrscr;
readln(s);
i:=0;n:=0;
repeat
inc(i);
if (s[i]=' ')or(s[i]=',') then begin
                   inc(n);
                   a[n]:=sub;
                   sub:='';
                   end
else sub:=sub+s[i];
until i=length(s);
inc(n);
a[n]:=sub;
writeln;
writeln('Input Etalon');
readln(sub);
writeln('=============================');
for i:=1 to n do
 begin
  m:=0;
  for j:=1 to length(sub) do
   if a[i][j]<>sub[j] then inc(m);
 if m=0 then if length(a[i])-1=length(sub) then writeln(a[i]);
 if m=1 then if length(a[i])=length(sub) then writeln(a[i]);
 end;
end.

[puporev]

uses crt;
const
rzd = [',', '-', '.','?','!',';',':'];//добавил
var slovo, etalon, st,s: string; //добавил s для временного хранения слов
    i, j, k: byte;
begin
clrscr;
write('st = ');
readln(st);
write('etalon = ');//исправил этанол на эталон
readln(etalon);
{formatirovanie stroki}
st :=st + ' '; //пробел в начало не нужен
for i := 1 to length(st) do
if st[i] in rzd then st[i] := ' ';
while pos('  ', st) > 0 do //здесь в кавычках обязательно два пробела
delete(st, pos('  ', st), 1);// и здесь, иначе удалите все пробелы
{poisk slov}
while pos(' ',st)>0 do//пока в строке есть пробелы
  begin
    slovo := copy(st, 1, pos(' ',st) - 1);//копируем очередное слово
    {esli dlina sl=dlina et}
 //объединять все три случая ошибки не надо, проще по отдельности
    if length(slovo)=length(etalon) then
       begin
         k:=0;
         for i := 1 to length (slovo) do
         if slovo[i]<>etalon[i] then inc(k);
         if k=1 then writeln(slovo);//если одна буква не совпадает
       end;
   {esli v slove 1 lishnya bukva}
   if length(slovo)-length(etalon)=1 then
      begin
        s:=slovo;
        for i:=1 to length(s) do
          begin
            delete(s,i,1);//удаляем по одной букве из слова и сравниваем
            k:=0;
            for j := 1 to length (s) do
            if s[j]=etalon[j] then inc(k);
            if k=length (etalon) then writeln(slovo);//если без 1 буквы совпадает
          end;
       end;
   {esli v slove propusshena bukva}
   if length(etalon)-length(slovo)=1 then//в этом случае также только слово и эталон меняем местами
      begin
        s:=etalon;
        for i:=1 to length(s) do
          begin
            delete(s,i,1);
            k:=0;
            for j := 1 to length (s) do
            if s[j]=slovo[j] then inc(k);
            if k=length (slovo) then writeln(slovo);
          end;
       end;
   delete(st,1,pos(' ',st));//удаляем просмотренное слово
 end;
readln
end.

Извините, не посмотрел. Кстати Ваш код выводит далеко не все слова.

[innaa639]

Огромное вам спасибо