Var a, a1:string;
    i:byte;
    b:char;
begin
     read(a);
     a:=a+' ';
     b:=' ';
     i:=pos(b, a);
     write('Words: ');
     while (i > 0) do
           begin
                a1:=copy(a, 1, i-1);
                delete(a, 1, i);
                if (length(a1)=3) then
                   write(a1, ' ');
                i:=pos(b, a);
           end;
end.

Вот, извини за задержку:)