Знаете, пожалуй я не буду дописывать Вашу программу, а просто предложу своё решение, а уж Вы думайте дальше. Дело в том, что значительную часть Вашего кода занимает заполнение файла, чего, как мне кажется, делать вовсе не нужно: файл должен быть подготовлен заранее, например, в каком-либо текстовом редакторе. И уж вовсе ни к чему выводить полное содержимое файла на экран.
Два замечания:
1. Имя и адрес файла в программе можете, естественно, поставить свои.
2. Текст в файле должен быть написан в одном регистре, например, только строчными буквами (или только прописными). Упорядочивать по алфавиту с учетом регистра - это вовсе убийство.
Код:
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.