Вот мое решение:
Uses CRT;
Type
S = array [1..30] of string;
Var
Symbol: Char;
I, J: Integer;
Word: S;
Begin
Repeat
TextBackground(0);
ClrScr;
For j := 1 to 30 do Word[J] := '';
I := 0;
Repeat
I := I + 1;
Repeat
Read (Symbol);
If (Not (Symbol in ['0'..'9'])) and (Symbol <> '_') then
Word[I] := Word[I] + Symbol;
{Read (Symbol);
If (Symbol in ['0'..'9']) or (Symbol = '_') or (Symbol = ' ') then
Word[i] := ''
else
Word[I] := Word[I] + Symbol;}
Until ((Symbol = ' ') or (Symbol = '.')) = true;
Until Symbol = '.';
For J := 1 to I do
Write (Word[J]);
Writeln;
Writeln ('Continue? (y/Y)');
Until not (ReadKey in ['y', 'Y']);
end.
Но в ней получается, что в слове храняться и пробелы, получается что если буквы+пробел > 10, то конец обрубается...