Небольшая задачка Опции

[Child of Bodom]

Помогите с одной задачкой, я ее вроде бы наклепал, но что то не правильно она работает. А условие здесь такое: Дан текстовый файл, в нем строчка. Так вот надо вывести все слова которые в ней есть(без повторения) и еще надо вывести сколько раз это слово встречается в строке. Вот что я наделал:

Program laba3_6;
uses crt;
type uk=^elem;
     elem=record
     Slovo:string;
     kol:byte;
     next:uk;
     end;
var z,beg:uk;
    f,g:text;
    st:string;
procedure INIT (var beg:uk);
var p:integer;
begin
reset (f);
rewrite (g);
readln (f,st);
p:=pos (' ',st);
beg^.slovo:=copy (st,1,p-1);
Beg^.kol:=1;
beg^.next:=nil;
writeln (g,st);
close (f);
close (g);
end;

procedure reading (var beg:uk);
var z,p:uk;
    st1:string;
    i,q:integer;
begin
reset (g);
readln (g,st);
i:=1;
while i<>length(st) do begin
   q:=pos(' ',st);
   st1:=copy (st,1,q-1);
   p:=beg;
   new (z);
   while (p^.next<>nil) or (p^.slovo<>st1) do begin
         if p^.slovo=st1 then p^.kol:=p^.kol+1
         else p:=p^.next;
         end;

   if p^.next=nil then begin
   z^.slovo:=st1;
   z^.kol:=1;
   p^.next:=z;
   z^.next:=nil;
   end;
   delete (st,1,q);
   end;
close (g);
end;
procedure vivod (var beg:uk);
var p:uk;
begin
p:=beg;
while p^.next<>nil do begin
write (p^.slovo:10);
write (p^.kol:15);
writeln;
p:=p^.next;
end;
end;
BEGIN
clrscr;
assign (f,'Stishok.txt');
assign (g,'vremenn.txt');
init (beg);
reading (beg);
vivod (beg);
readln;
end.

Как бы мне кажется здесь все почти правильно , но где то ошибка поэтому программа не работает

[Артемий]

Свое раздражение тут показывать не надо!Пользуйся поиском ибо "ничего не понятно"!

Добавлено через 1 мин.
Было уже подобное.