Определить количество слов, имеющих количесто символов первого слова

uses crt;
var s:string;
    n,i,j,k,k1:byte;
begin
clrscr;
writeln('Введите последовательность слов, разделенных пробелами');
readln(s);
n:=pos(' ',s);
k1:=1;{если считать и первое слово, если нет, то k1:=0;}
i:=n+1;
while i<=length(s) do
if (s[i]<>' ')and ((s[i-1]=' ')or(i=1)) then{если буква, а перед ней пробел, или она первая}
 begin
  k:=i;j:=1;
  while (s[k]<>' ')and(k<=length(s))do {пока не пробел и не конец строки}
   begin
    k:=k+1;{идем вперед}
    j:=j+1;{длина слова}
   end;
  if j=n then k1:=k1+1;
  i:=i+j;{перепрыгиваем}
 end
else i:=i+1;
write('K=',k1);
readln
end.

if (s[i]<>' ')and ((s[i-1]=' ')or(i=1)) then{если буква, а перед ней пробел, или она первая}
 begin
  k:=i;j:=1;s1:='';
  while (s[k]<>' ')and(k<=length(s))do {пока не пробел и не конец строки}
   begin
    s1:=s1+s[k];
    k:=k+1;{идем вперед}
    j:=j+1;{длина слова}
   end;
  if j=n then 
    begin
     write(s1,' ');
     k1:=k1+1;
    end; 
  i:=i+j;{перепрыгиваем}
 end

uses crt;
var s,s1:string;
    n,i,j,k,k1:byte;
begin
clrscr;
writeln('Введите последовательность слов, разделенных пробелами');
readln(s);
n:=pos(' ',s);{длина первого слова}
k1:=0;
i:=n+1;{первое слово не считаем}
writeln('Слова, равные по длине первому:');
while i<=length(s) do
if (s[i]<>' ')and ((s[i-1]=' ')or(i=1)) then{если буква, а перед ней пробел, или она первая}
 begin
  k:=i;j:=1;s1:=s[i];
  while (s[k]<>' ')and(k<=length(s))do {пока не пробел и не конец строки}
   begin
    k:=k+1;{идем вперед}
    s1:=s1+s[k];{составляем слово}
    j:=j+1;{длина слова}
   end;
  if j=n then
   begin
    k1:=k1+1;
    write(s1,' ');{выводим слово}
   end;
  i:=i+j;{перепрыгиваем}
 end
else i:=i+1;
writeln;
if k1=0 then write('Таких слов нет!')
else write('Их количество=',k1);
readln
end.