Строковый тип данных. С наработками. Работает, но не верно

program pr2;
var str1,str2,str:string; n,n1:integer; chr:char;
begin
readln(str);
str1:=str; {копирую основную строку в вспомогательную}
n:=1;
 
{Здесь хотела сравнение слов поочереди всех сделать, но что-то не очень, по моему косяк где-то здесь =))}
 
repeat
delete(str1,pos(' ',str),length(str)-pos(' ',str)); {удаляю из первой вспомогательной строки все, кроме первого слова}
delete(str,1,length(str1)); {удаляю первое слово из основной строки}
writeln(str); writeln(str1); {вывожу =)}
str2:=str; {копирую основную во вторую вспомогательную}
delete(str2,pos(' ',str),length(str)-pos(' ',str)); {удаляю из второй вспомогательной все кроме второго слова (теперь оно первое, после пред. удаления =))}
writeln(str); writeln(str2); {вывожу}
inc(n); {счетчик}
until length(str1)>length(str2);
writeln(n);
 
{Дальше кажется правильно =)}
 
{Вводим символ}
readln(chr);
n1:=0;
{Подсчитываем кол-во этих символов}
while pos(chr,str2)<>0 do
begin
delete(str2,pos(chr,str2),1);
inc(n1); {Счетчик кол-ва сиволов}
end;
write(n1);
readln;
end.

var
a,t:string;
b:array[1..100]of string;
c:char;
i,k,nom,kol:integer;
begin
writeln('vvedite stroku');
readln(a);
writeln('vvedite bukvu');
readln(c);
a:=' '+a;
for i:=1 to length(a) do
if a[i]=' 'then inc(k) else b[k]:=b[k]+a[i];
for i:=k downto 2 do
if length(b[i])<length(b[i-1])then 
begin
t:=b[i];
nom:=i;
end;
if nom<>0 then writeln('nomer=',nom) else writeln('takogo slova net');
for i:=1 to length(t) do
if t[i]=c then inc(kol);
writeln('bukva v slove vstretitsya ',kol,' raz');
readln;
end.