Ошибка в программе

[T@tali]

программа выдает не тот результат. кто подскажет что здесь не так? она должна удалять 2раза слово если оно встретилось три раза

Program w;
var
a:string;
procedure ClearWord(e:string;var f:string);
begin
while length(e)>2 do
begin
f[pos(e,f)+1]:=' ';{стираем проверенное слово}
delete(e,2,1);{удаляем символ}
end;
end;
function CountWord(e,f:string):integer;
begin
if pos(e,f)>0 then
begin
delete(f,pos(e,f)+1,length(e)-2);{удаляем посчитаное слово}
 CountWord:=CountWord(e,f)+1;{ищем следующее}
end
else CountWord:=0;{сбрасываем счетчик}
end;
function FirstWord(e:string):string;
begin
while (e[1]=' ')and(length(e)>0) do
delete(e,1,1);{удаляем начальные пробелы}
FirstWord:=copy(e,1,pos(' ',e)-1){копируем слово}
end;
function WordKill(b:string):string;
var
c,d:string;
begin
c:=b;{котрольная строка}
d:='.,`!@#$%^&*()_[]{}0;:';{все символы, являющиеся знаками препинания}
while length(d)>0 do
begin
while pos(d[1],c)>0 do
c[pos(d[1],c)]:=' ';{заменяем знак препинания}
delete(d,1,1);{удаляем проверенный символ}
end;
while length(FirstWord(c))>0 do{пока ещё есть слова}
begin
d:=' '+FirstWord(c)+' ';{выделяем очередное слово}
if CountWord(d,c)>3 then{выподняем условие}
begin
delete(b,pos(d,c)+1,length(d)-2);
delete(c,pos(d,c)+1,length(d)-2);
delete(b,pos(d,c)+1,length(d)-2);
delete(c,pos(d,c)+1,length(d)-2);
 end;
while pos(d,c)>0 do
ClearWord(d,c);{заменяем проверенное слово пробелами}
end;
WordKill:=b;
end;
begin
  write('Enter string:');
  readln(a);
  a:='asd asd 1 asd asdf asd';{контрольная строка}
  a:=' '+a+' ';{добавляем разделители}
  writeln('Result:',WordKill(a));{выводим результат}
  readln;
end.

[Pein95]

вы сначало код сделайте читабельным(

[Летучий_СкилетиК]

ваша программа работает правильно, вот только работает всегда на 1 случай; строка a:='asd asd 1 asd asdf asd', не зависимо от вводимого значения строковой переменной a

 readln(a);
  a:='asd asd 1 asd asdf asd';

удалите эту строку оставте только оператор ввода ReaLn(a);

[T@tali]

все равно не удаляет выводит тоже что и ввела

[Летучий_СкилетиК]

ваш код работает на 100%

Program w;
var
a:string;
procedure ClearWord(e:string;var f:string);
begin
while length(e)>2 do
begin
f[pos(e,f)+1]:=' ';{стираем проверенное слово}
delete(e,2,1);{удаляем символ}
end;
end;
function CountWord(e,f:string):integer;
begin
if pos(e,f)>0 then
begin
delete(f,pos(e,f)+1,length(e)-2);{удаляем посчитаное слово}
 CountWord:=CountWord(e,f)+1;{ищем следующее}
end
else CountWord:=0;{сбрасываем счетчик}
end;
function FirstWord(e:string):string;
begin
while (e[1]=' ')and(length(e)>0) do
delete(e,1,1);{удаляем начальные пробелы}
FirstWord:=copy(e,1,pos(' ',e)-1){копируем слово}
end;
function WordKill(b:string):string;
var
c,d:string;
begin
c:=b;{котрольная строка}
d:='.,`!@#$%^&*()_[]{}0;:';{все символы, являющиеся знаками препинания}
while length(d)>0 do
begin
while pos(d[1],c)>0 do
c[pos(d[1],c)]:=' ';{заменяем знак препинания}
delete(d,1,1);{удаляем проверенный символ}
end;
while length(FirstWord(c))>0 do{пока ещё есть слова}
begin
d:=' '+FirstWord(c)+' ';{выделяем очередное слово}
if CountWord(d,c)>3 then{выподняем условие}
begin
delete(b,pos(d,c)+1,length(d)-2);
delete(c,pos(d,c)+1,length(d)-2);
delete(b,pos(d,c)+1,length(d)-2);
delete(c,pos(d,c)+1,length(d)-2);
 end;
while pos(d,c)>0 do
ClearWord(d,c);{заменяем проверенное слово пробелами}
end;
WordKill:=b;
end;
begin
  write('Enter string:');
  readln(a);
  a:=' '+a+' ';{добавляем разделители}
  writeln('Result:',WordKill(a));{выводим результат}
  readln;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.