Файлы и строки

Var f1,f2:text;
    s,st,min,str:string;
    ch:char;
    k:byte;
Begin
    Assign(f1,'in.txt');Reset(f1);
    Assign(f2,'out.txt');Rewrite(f2);
    write('Заданная буква: ');readln(ch);
    While not Eof(f1) do
    Begin
      readln(f1,s);
      s:=s+' ';str:='';k:=0;
      While (Pos(' ',s)>0)and (k=0) do
      Begin
        st:=Copy(s,1,Pos(' ',s)-1);
        Delete(s,1,Pos(' ',s));
        if st<>'' then
         if st[1]<>ch then str:=str+st+' '
          else k:=1;
      End;
      if (str<>'')and(k=0) then writeln(f2,str);
    End;
    Close(f1);Close(f2);
    Reset(f2);
    While not Eof(f2) do
    Begin
      readln(f2,s);
      if min='' then min:=s;
      While Pos(' ',s)>0 do
      Begin
        st:=Copy(s,1,Pos(' ',s)-1);
        Delete(s,1,Pos(' ',s));
        if (Length(st)<Length(min))and(min<>'') then min:=st;
      End;
    End;
    writeln('Min слово = ',min);
    Close(f2);
    readln;
End.

var
  f1, f2: text;
  s, ms: string;
  c: char;
  i, j, m: integer;
begin
  Write('Введите букву: '); ReadLn(c);
  Assign(f1,'input.txt'); Assign(f2,'output.txt');
  Reset(f1); Rewrite(f2);
  m:=256;
  while not eof(f1) do begin
    ReadLn(f1,s);
    if Pos(' '+c,' '+s)=0 then begin
      WriteLn(f2,s);
      i:=1;
      while i<=Length(s) do begin
        while (s[i]=' ') and (i<=Length(s)) do inc(i);
        j:=i;
        while (s[i]<>' ') and (i<=Length(s)) do inc(i);
        if (i-j>0) and (i-j<m) then begin
          m:=i-j; ms:=Copy(s, j, m);
        end;
      end;
    end;
  end;
  Close(f1); Close(f2);
  WriteLn('Самое короткое слово в f2: "',ms,'".');
end.