Напечатать первую из самых коротких строк файла

type FP=text; 
Var F1:FP;
Procedure proc(var F1:FP);
var s:string;n:integer;
begin
rewrite(f1); writeln('введи число строк'); read(n);
For var i:=1 to  n do begin
readln(s); writeln(f1,s); end; 
close(f1); end;
procedure Minn(F1:FP);
Var A:array[1..100] of string;
i:integer; k, Min:integer; imin:integer;
begin
reset (f1);
K:=0; Min:=10000; i:=1; imin:=1;
While not Eof(F1) do 
 begin
Read(F1, A[i]);  (*Здесь происходит что-то не то... Ошибка времени выполнения: индекс находился вне границ массива*)
k:=length (A[i]); 
If K<Min then 
begin
Min:=K; imin:=i; End;
i:=i+1; 
end;
Writeln ('первая из коротких строк ', A[imin]); 
close(f1); 
end;
begin
assign(F1,'С:\123.txt');
 proc(F1); 
 Minn(F1);
end.

Procedure proc_1(var F1:text);
var s:string;
    n:integer;
begin
rewrite(f1);
writeln('введи число строк');
readln(n);
For var i:=1 to  n do
 begin
  readln(s); 
  writeln(f1,s); 
 end;
close(f1); 
end;
procedure proc_2(var F1:text);
Var s,smin:string;
    min:integer;
begin
reset (f1);
readln(f1,s);
min:=length(s);
smin:=s;
While not Eof(F1) do
 begin
  readln(F1,s);
  if length(s)<min then
   begin
    min:=length(s);
    smin:=s;
   end; 
 end;  
close(f1);  
Writeln ('первая из коротких строк ', smin);
end;
var F1:text;
begin
assign(F1,'123.txt');//в папку с программой, на диск С не нужно
proc_1(F1);
proc_2(F1);
end.