Поиск самого длинного и короткого слова

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
Const nmax = 1000;
Type Tw = array[1..nmax] of string[255];
 
Const ZnakP : set of Char=
              ['.',',',':',';','?','!','=','-'];
 
Function DelZnakP(Var s : string) : word;
Var i : word;
Begin
  Result:=0;
  for i:=1 to length(s) do
    if s[i] in ZnakP then 
      begin inc(Result); s[i]:=' '; end;
End;
 
Function StrToWord(s : string; Var w : Tw) : word;
Begin
  Result:=0;
 
  if s='' then Exit;
  while pos('  ',s) <> 0 do 
        delete(s, pos('  ',s),1);
  if s=' ' then Exit;
  if s[1]=' ' then delete(s,1,1); 
  if s[length(s)]<>' ' then s:=s+' '; 
  writeln(s); 
while s<>'' do
  begin
    inc(Result);                         
    w[Result]:=copy(s, 1, pos(' ',s)-1); 
    delete(s,1,pos(' ',s));              
    writeln(w[Result]);  
  end;
End;
 
Var ft : Text;// это файл на внешнем носителе,
     w, ws, wr : Tw;  // а это массив строк - образ файла
    nz, i, j, nwr, nws : word;// –размерность массива строк
    s :string;
 
begin
  //Чтение из файла 
  AssignFile(ft,'Project2.dpr');
  Reset(ft);
  nz:=0;
  while not EoF(ft) do
  begin
    inc(nz); readln(ft, w[nz]); writeln(w[nz]);
  end;
  CloseFile(ft);
 
//Формирование словаря
  nwr:=0; // глобальный счетчик слов
  for i:=1 to nz do // цикл по строкам
  begin
    s:=w[i];
    DelZnakP(s);
    nws:=StrToWord(s, ws);// Слов в строке
    for j:=1 to nws do // цикл по словам в строке
    begin
      //writeln(ws[j]); // отладка если надо
      inc(nwr); wr[nwr]:=ws[j];
    end;
  end;
 
  Readln;
end.

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
const
  sep_arr: String = '.,:;?!=- <>{}[]@#$%^&*'; // separators
 
var
  fl: TextFile;
  sep: set of Char; // множество разделительных символов
  s, buff: String;
  i, // счётчик для циклов
  min_index, min_length, // индекс и длина минимального по длине слова слова
  max_index, max_length: Integer; // то же для макс. по длине слова
  Words: Array of String; // динамический массив слов
 
begin
  // подготовим множество сепереторов (разделительных символов)
  sep := [];
  for i := 1 to Length(sep_arr) do
    sep := sep + [sep_arr[i]];
  // загружаем файл
  s := '';
  AssignFile(fl, 'input.txt');
  Reset(fl);
  While not EOF(fl) do
    begin
      ReadLn(fl, buff);
      s := s + buff + ',';
    end;
  CloseFile(fl);
  // разделяем файл на слова
  buff := '';
  SetLength(words, 0); // обнулили массив
  for i := 1 to Length(s) do
    If s[i] in sep then
      begin
        If buff = '' then
          continue;
        SetLength(words, High(words) + 2); // добавляем в конец 1 элемент
        words[High(words)] := buff; // добавляем в него слово
        buff := ''; // буфер стираем (для чтения слудующего слова)
      end
    else
      buff := buff + s[i];
  If High(words) = -1 then
    halt;
  // ищем требуемые слова
  max_index := 0;
  min_index := 0;
  min_length := Length(words[0]);
  max_length := min_length;
  for i := 1 to High(words) do
    begin
      If Length(words[i]) > max_length then
        begin
          max_length := Length(words[i]);
          max_index := i;
        end;
      If Length(words[i]) < min_length then
        begin
          min_length := Length(words[i]);
          min_index := i;
        end;
    end;
  // записываем слова в файл
  AssignFile(fl, 'output.txt');
  Rewrite(fl);
  WriteLn(fl, '+++', words[max_index]);
  WriteLn(fl, '---', words[min_index]);
  CloseFile(fl);
end.

  // записываем слова в файл
  AssignFile(fl, 'output.txt');
  Rewrite(fl);
  for i := 0 to High(words) do
    If i = max_index then
      WriteLn(fl, '+++', words[max_index])
    else if i = min_Index then
      WriteLn(fl, '---', words[min_index])
    else
      WriteLn(fl, words[i]);
  CloseFile(fl);