Программа с текстовым файлом

[RsGoLd]

Для указанного текстового файла составьте список слов, которые:
1. встречаются в нем более одного раза. В алфавитном порядке с частотой их повторения.
2. встречаются в нем только один раз. В алфавитном порядке.
3.самое короткое и самое длинное слово, предложение.
я уже прописал и программа находит самое короткое и самое длинное слово, а вот как прописать чтобы находил и выводил 1 и 2 задание не пойму. помогите...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls;     


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    RichEdit1: TRichEdit;
    procedure N3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);



  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function  est_2_prob(s: string): boolean;
  var i: integer;
  begin
  result:=false;
  for i:=1 to length(s)-1 do if (s[i]=' ') and (s[i+1]=' ') then result:=true;
  end;

procedure TForm1.N3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button1Click(Sender: TObject);

begin
OpenDialog1.Execute;
if opendialog1.FileName <> '' then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
if memo1.Text<>'' then Button2.Enabled:=true else button2.Enabled:=false;

end;

procedure TForm1.Button2Click(Sender: TObject);

var
i,k,min :integer;
text,text1,slovo,min_slovo,max_slovo:string;
begin

//cчитываем текст
text:=memo1.Text;

//убираем лишние пробелы из этого текста
while est_2_prob(text) do
  begin
  i:=0;
  repeat
  i:=i+1;
  if (text [i] = ' ') and (text[i+1] = ' ') then delete (text, i, 1);
  until i=(length(text)-1);
  end;

//ситуация когда пробелы стоят в начале и конце, то удаляем их
if text[1]=' ' then delete(text,1,1);
if text[length(text)]=' ' then delete(text,length(text),1);

//выдали текст без лишних пробелов
richedit1.Text:=text;

//считем количество слов
k:=0;
text:= richedit1.Text;
for i:=1 to length(text) do
if text [i] = ' ' then k:= k+1;
richedit1.Lines.Add('колличество слов: ' + IntTostr(k+1));

//ищем самое короткое слово
text1:=text;
//ситуация когда слово 1, то оно и будет самым коротким
if (k+1)=1 then richedit1.Text:=richedit1.text+#13+#13+ 'Самое короткое слово: '+text1+ ' оно единственное.' else
  //если же слов больше то
  i:=0;
  repeat i:=i+1 until text[i]=' ';
  min_slovo:=copy(text1,1,i-1);
  delete(text1,1,i);
  while length(text1)<>0 do
    begin
    i:=0;
    repeat
    i:=i+1;
    until (text1[i]=' ') or (i=length(text1));
    slovo:=copy(text1,1,i-1);
    if length(slovo)<length(min_slovo) then min_slovo:=slovo;
    delete(text1,1,i);
    end;
  richedit1.Text:=richedit1.Text+#13+#13+'самое короткое слово: '+min_slovo;

//ищем саоме длиное слово
text1:=text;
//ситуация когда слово 1, то оно и будет самым коротким
if (k+1)=1 then richedit1.Text:=richedit1.text+#13+#13+ 'Самое длиное слово: '+text1+ ' оно единственное.' else
  //если же слов больше то
  i:=0;
  repeat i:=i+1 until text[i]=' ';
  max_slovo:=copy(text1,1,i-1);
  delete(text1,1,i);
  while length(text1)<>0 do
    begin
    i:=0;
    repeat
    i:=i+1;
    until (text1[i]=' ') or (i=length(text1));
    slovo:=copy(text1,1,i-1);
    if length(slovo)>length(max_slovo) then max_slovo:=slovo;
    delete(text1,1,i);
    end;
  richedit1.Text:=richedit1.Text+#13+#13+'самое длиное слово: '+max_slovo;

end;

end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.