Не могу понять почему вылетает 3 процедурка, помогите

[Taisja]

Не могу понять, почему программка вылетает из-за 3 процедурки, в консоли все работало, Помогите разобраться, пожалуйста.
Списки
Составить программу, которая в списке L из каждой группы подряд идущих
одинаковых элементов оставляет только один.
implementation

{$R *.dfm}
type sp=^zap;
zap=record
inf:integer;
next:sp end;
var nach,p:sp;
bp:sp=nil; ep:sp=nil;
//заполнение списка
procedure TForm1.Button1Click(Sender: TObject);
var p:sp;
begin
new(p);
p^.inf:=strtoint(edit1.Text);
p^.next:=nil;
if bp =nil then bp:=p
else ep^.next:=p;
ep:=p;
edit1.Text:='';
edit1.SetFocus;
end;
//вывод списка
procedure TForm1.Button2Click(Sender: TObject);
var p:sp; s:string; n:integer;
begin
memo1.Lines.Clear;
n:=0;
s:='';
p:=bp;
while p<>nil do
begin
n:=n+1;
s:=s+inttostr(p^.inf)+#13#10;
p:=p^.next;
end;
if n<>0 then
memo1.Lines.Add('список'+#13#10+s)
else memo1.Lines.Add('список пуст');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
p:=nach;
while p^.next <> nil do
if p^.inf = p^.next^.inf then p^.next:=p^.next^.next
else p:=p^.next;
end;end.

Консольный вариант:
program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

type sp=^zap;
zap=record
inf:integer;
next:sp end;
var nach,p2,p:sp; a:integer;
begin
new(p);
nach:=p;
writeln('Введи числа до 0');
readln(nach^.inf);
repeat
p2:=p;
new(p);
p2^.next:=p;
readln(a);
if a<>0 then p^.inf:=a else p2^.next:=nil;
p^.next:=nil;
until a=0;
p:=nach;
while p^.next <> nil do
if p^.inf = p^.next^.inf then p^.next:=p^.next^.next
else p:=p^.next;
p:=nach;
while p<>nil do
begin
write(p^.inf,' ');
p:=p^.next;
end;
writeln;
readln;
end.

[alexBlack]

Вы nach на bp заменили не везде:
p:=nach;

[Taisja]

Большое спасибо! В следующий раз буду внимательней.