program slova;

uses crt;

var s, s1: string;

       i, k: integer;

begin

 clrscr;

 writeln ('Vvedite text: ');

 readln (s1);

 write ('Slova soderjaschie ne bolee 3-h bukv: ');

 for i:=1 to length(s) do

 begin

  if s[i]<>' ' then

   begin

    s1:=s1+s[i];

    k:=k+1;

   end

  else

   if k<=3 then

    begin

     write (', ',s1);

     k:=0;

     delete (s1,1,3);

   end

    else

      begin

       k:=0;

       delete (s1,1,15);

     end;

  end; 

readln;

end.

Вроде так, но у меня щас нету компилятора, так что проверить не могу. Если что-то будет ругаться, или вопросы какие - пиши в личку.