Текстовые файлы. Переписать в новый текстовый файл все слова наименьшей длины

Program Laba2_2_1;
uses crt;
var
f,t:text;
slovo,min,x:string;
r,i:integer;
begin
assign(f,'file2_2_1_1.pas');
reset(f);
assign(t,'file2_2_1_2.pas');
rewrite(t);
readln(f,slovo);
r:=pos(',',slovo);
min:=copy(slovo,1,r-1);
delete(slovo,1,r);
end.

uses crt;
const p: set of char=[' ','.',','];
var f,g: text;
    s,sl: string;
    i,dmin: byte;
 
begin
assign(f,'C:\in.txt');
assign(g,'C:\out.txt');
reset(f);
dmin:=255;
while not (eof(f)) do
      begin
      readln(f,s);  s:=s+' ';
      sl:='';
      for i:=1 to length(s) do
          if not (s[i] in p) then sl:=sl+s[i] else
             if length(sl)>0 then
             begin
             if length(sl)<dmin then dmin:=length(sl);
             sl:='';
             end;
      end;
writeln('Минимальная длина слова ',dmin);
reset(f);
rewrite(g);
while not (eof(f)) do
      begin
      readln(f,s);  s:=s+' ';
      sl:='';
      for i:=1 to length(s) do
          if not (s[i] in p) then sl:=sl+s[i] else
             begin
             if length(sl)=dmin then writeln(g,sl,' ');
             sl:='';
             end;
      end;
writeln('Слова записаны в новый файл');
close(f);
close(g);
end.