помогите с работой с односвязными списками Паскаль

[neon0858]

привет,ребята...я видимо что-то намудрил с прогой посмотрите пожалуйста

задание

Реализовать динамическую структуру, указанную в варианте с помощью указателей в динамической области памяти.

Данные из файла «результаты сессии ФИТ» (код группы, ФИО, оценки за экзамены) ввести в динамический список, упорядоченный по ФИО в каждой группе. Удалить из списка всех неуспевающих, предварительно вывести на экран.


листинг Что-то происходит не так с процедурами del и vivod_s

program Project2;
uses crt;

type uk=^elem;
elem=record
inf_c:integer;
inf_f:string;
inf_o:integer;
next:uk;
end;
var beg,tail,temp:uk;


type
Product = record
c: integer;
f: string;
o: integer;
end;

type fail = file of product;

var f1:fail;
spr: product;
otv:char;
n,n1:integer;


{----------------------------------------------------------------------}
procedure tabl;
begin
writeln;
writeln('-----------------------------------------------');
writeln('| Code | Fio | Ocenki |');
writeln('-----------------------------------------------');
reset(f1);
while not eof(f1) do
begin
read(f1,spr);
with spr do
write('|',c:11,' |',f:11,' |',o:11,'|');
writeln;
end;


writeln('-----------------------------------------------');
close(f1);
end;
{-----------------------------------------------------------------------}

procedure sort ;
var tail,temp:uk;
x:string;
y,w:integer;
begin
y:=0;
w:=0;
temp:=beg;
while temp<>nil do
begin
tail:=temp;
while tail<>nil do
begin
if tail^.inf_f<temp^.inf_f then
begin
x:=tail^.inf_f;
y:=tail^.inf_o;
w:=tail^.inf_c;
tail^.inf_f:=temp^.inf_f;
tail^.inf_o:=temp^.inf_o;
tail^.inf_c:=temp^.inf_c;
temp^.inf_f:=x;
temp^.inf_o:=y;
temp^.inf_c:=w;
end;
tail:=tail^.next;
end;
temp:=temp^.next;
end;
end;


{----------------------------------------------------------------------}




procedure vivod;
var temp :uk;
begin
temp:=beg ;
writeln;
writeln('-----------------------------------------------');
writeln('| Code | Fio | Ocenki |');
writeln('-----------------------------------------------');
while temp<>nil do
begin
writeln('|',temp^.inf_c:15,'|',temp ^.inf_f:15,'|',temp^.inf_o:15,'|');
temp:=temp^.next;
end;
writeln('-----------------------------------------------');
end;

{__________________________________ ______________________________}
procedure vivod_s;
var temp:uk;
begin
temp:=beg ;
writeln;
writeln ('spisok neyspevayschih');
writeln('-----------------------------------------------');
writeln('| Code | Fio | Ocenki |');
writeln('-----------------------------------------------');
while temp<>nil do
begin
if temp^.inf_o<3 then
begin
writeln('|',temp^.inf_c:15,'|',temp ^.inf_f:10,'|',temp^.inf_o:10,'|');
temp:=temp^.next;
end;
end;
writeln('-----------------------------------------------');
end;

{----------------------------------------------------------------------}



procedure del (var beg:Uk);
var p1, p,w:Uk;
flag:boolean;
procedure Del_beg(var p:Uk);
begin
w:=beg;
beg:=beg^.next;
dispose(w);
p:=beg;

end;

procedure del_for_Him (p:Uk);
begin
w:=p^.next;
p^.next:=p^.next^.next;
dispose(w);
end;
begin
p:=beg;
flag:=true;
repeat
if p^.inf_o<3 then
if flag then
Del_beg(p)
else
Del_for_him(p1)
else
begin
p1:=p;
p:=p^.next;
flag:=false;
end;
until p=nil;
end;













{----------------------------------------------------------------------}
BEGiN
clrscr;
Assign(f1,'C:\ssesia.dat');
rewrite(f1);
repeat
with spr do
begin
randomize;
new(temp);
writeln('code');
readln(c);
writeln('fio');
readln(f);
writeln('ocen');
readln(o);

temp^.inf_c:=c;
temp^.inf_f:=f;
temp^.inf_o:=o;
temp^.next:=beg;
beg:=temp;

end;
write(f1,spr);
writeln('prodolsh(y/n)');
readln(otv);
until upcase(otv)='N';
close(f1);

tabl;
readln;
sort;
writeln;
vivod;
writeln;
vivod_s;
readln;
del(beg);
vivod;
readln;
end.






зарание спасибо)

[L_M]

в Del несмотря на зопоминание элемента, ты удаляешь именно его, а не копию данных. надо так:
(если список p1->p2->p3)

w:=p2;
p1^.next:=p3
dispose(w);

[neon0858]

попробывал,ничего путно не дало(