Написать программу с последовательностью

[Татьяна12678]

Помогите пожалуйста написать программу(Pascal ABC).Вот условие :Дана последовательность,содержащая от 1 до 30 слов, в каждом из которых от 1 до 5 строчных латинских букв,между соседними словами-запятая,за последними словами-точка.Напечатать все различные слова,встречающиеся в последовательности более двух раз.Оочень нужно,заранее огромное спасибо!!!!
Вот,я попыталась написать,но мне кажется неправильно:
uses crt;
var base:array[1..30] of string;
i,j,n:integer;
t:boolean;
s,buf:string;
f:text;
begin
clrscr;
assign(f,'text');
rewrite(f);
reset(f);
close(f);
writeln(s);
for i:=1 to length(s) do
begin
if s[i] in['.',','] then
begin
t:=true;
for j:=1 to n do if base[j]=buf then t:=false;
if t then
begin
if n<30 then inc(n) else break;
base[n]:=buf;
end;
buf:='';
if s[i]='.' then break;
end else
buf:=buf+s[i];
end;
assign(f,'text');
rewrite(f);
writeln(f,s);
s:='';
for i:=1 to n do s:=s+base[i]+',';
s[length(s)]:='.';
writeln(s);
writeln(f,s);
close(f);
readln;
readln;
end.

[GetMax]

Ерунда у вас какая то написана.

Напечатать все различные слова,встречающиеся в последовательности более двух раз.

Это можно сделать так

var base:array[1..30] of string;
i,j,n,kol,count:integer;
s,buf:string;
f:text;
begin
  writeln('s: ');
  Readln(S);
  Kol:=0;
  j:=1;
  for i:=1 to length(s) do    // разбиваем строку на массивы
  begin
    if not (s[i] in['.',',']) then
    Base[j]:=Base[j]+S[i];
    if  s[i] in['.',','] then
    Begin
      Inc(Kol);
      Inc(j)
    End;
  End;
  For i:=1 to Kol do      // удаляем лишние пробелы из строк массива
  Begin
    While Pos(' ',Base[i]) > 0 do
    Delete(Base[i],Pos(' ',Base[i]),1)
  end;
  buf:='';
  For i:=1 to Kol-1 do   //ищем слова, чье количество больше двух
  Begin
    count:=0;
    For j:=i to Kol do
    If Base[i]=Base[j] then Inc(Count);
    If (Count > 2) and (Pos(Base[i],buf) = 0) then buf:=Buf+' '+Base[i]
  End;
  Writeln(Buf);
  readln
End.

А вот запись в файл пробуйте реализовать сами. Там нет ничего сложного.