type
  // будем использовать записи с двумя полями: слово и количество таких слов в тексте 
  TWord = record
    WRD: string;
    number: byte;
  end;

type
  TWords = array of TWord;

var
  Words: TWords; // все слова текста
  EndSymbols: set of char; // символы, которые ограничивают слово

...

procedure AddWord (word: string); // добавление нового слова в список
var
  i: integer;
  lnth: byte;
  NewWord: boolean;
begin
  lnth := length(Words);
  NewWord := true;

  // проверяем, не добавлено ли это слово уже в список слов
  for i := 0 to lnth-1 do 
    if Words[i].WRD = word then
      begin
        NewWord := false;
        // если в списке, то увеличиваем счетчик для него
        Words[i].number := Words[i].number + 1; 
        break
      end;

  if NewWord then // если не в списке, то добавляем
    begin
      SetLength(Words, lnth+1);
      Words[lnth].WRD := word;
      Words[lnth].number := 1;
    end;
end;

procedure FindWords(Text: string);
var
  i: integer;
  tmpstr: string;
begin
  EndSymbols := [' ', '.', ',', '!', '?', ':', ';', '"'];
  tmpstr := '';

  for i := 1 to length(Text) do // ищем все слова в строке
    if not(Text[i] in EndSymbols)
      then
        begin
          tmpstr := tmpstr + Text[i];
          if i = length(Text) then
            AddWord(tmpstr);
        end
    else
      if length(tmpstr) > 0 then
        begin
          AddWord(tmpstr);
          tmpstr := '';
        end;
end;

function FindShortWord: TWord; // ищем самое короткое слово
var
  min: byte;
  i: integer;
begin
  min := 0;

  for i := 1 to length(Words) - 1 do
    begin
      if length(Words[i].WRD) < length(Words[min].WRD) then
        min := i;
    end;

  Result := Words[min];
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  tmp: TWord;
begin
  for i := 0 to Memo1.Lines.Count-1 do
    FindWords(memo1.Lines[i]);

 tmp := FindShortWord;
 ShowMessage('Самое короткое слово: '+ tmp.WRD + '. Встречается раз: ' + IntToStr(tmp.number));
end;