uses crt;
var
 f1:text;
 nam:string; {имя файла}
 mass:array[1..200] of string; {массив слов длиной n}
 n:integer; {длина слова}
 k:integer; {количество слов длиной n}
 i,j:integer;
 st:string; 
begin
 clrscr;
 write('Введите имя файла: ');
 readln(nam);
 assign(f1,nam); 
 rewrite(f1);
 writeln('Введите текст для записи в файл:');
 readln(st);
 writeln(f1,st);
 write('Введите длину слова n: ');
 k:=0;
 readln(n);
 writeln('Содержимое файла');
 reset(f1);

Const
 Smb=[' ',',','.','?','!',':',';','"','(',')','-'];
VAR
 S:String;
 W,W1:Array[1..1000] of String;
 i,j,i1,i2,leng:Byte;
 N,K:Word;
 b:Boolean;
 f:Text;

BEGIN
 Assign(f, 'D:\fff.txt');
 ReSet(f);
 N:=0;
 REPEAT
  ReadLn(f,S);
  i:=0;
  Repeat
   b:=false;
   Repeat
    Inc(i);
   Until (Not (S[i] in Smb)) or (i=Length(S));
   If i<Length(S) then
    begin
     i1:=i;
     While (Not (S[i] in Smb)) and (i<Length(S)) do
      begin
       Inc(i);
       b:=true;
       i2:=i;
      end;
     If b then
      begin
       Inc(N);
       W[N]:=Copy(S,i1,i2-i1);
      end;
    end;
  Until i=Length(S);
 UNTIL EoF(f);
 Close(f);
 Write('The length of the word = ');
 Readln(leng);
 K:=0;
 For i:=1 to N do
  If Length(W[i])=leng then
   begin
    Inc(K);
    W1[K]:=W[i];
   end;
 { Alphabet ordering }
 For i:=1 to K do
  For j:=1 to K-i do
   If Ord(W1[j][1])>Ord(W1[j+1][1]) then
    begin
     S:=W1[j];
     W1[j]:=W1[j+1];
     W1[j+1]:=S;
    end;
 For i:=1 to K do
  Write(W1[i]+' ');
 ReadLn;
END.