Tài liệu Bài tập tin danh sách móc nối đơn pptx

Danh sách móc nối đơn
program kieucontro;
type con_tro = ^danh_sach;
danh_sach = record
ho_ten: string[23];
que_quan: string[15];
lop: string[8];
sbd: string[9];
next : con_tro;
end;
var head,l : con_tro; chon: byte; traloi: char; i:byte; k: integer;
procedure nhap_ds(var l: con_tro);
var p: con_tro; ans: integer;
begin
while true do
begin new(p);
with p^ do begin
write('nhap ho va ten: '); readln(p^.ho_ten);
write('nhap que quan: '); readln(p^.que_quan);
write('nhap lop: ') ; readln(p^.lop);
write('nhap so bao danh: '); readln(p^.sbd);
end;
p^.next:=NIL;
if head=NIL then begin head:= p; l:= p end
else begin l^.next:= p; l:= p end;
write('Co tiep tuc khong 1/0 ? '); readln(ans);
if ans=0 then break;
end;
end;
function length( var L: con_tro): integer;
var dem: integer;

begin
l:=l^.next; dem:=dem+1;
end;
procedure Duyet_ds(var l: con_tro);
var p: con_tro;
begin
if head = NIL then begin writeln('Danh sach rong'); exit end;
p := head;
while p <> NIL do
begin with p^ do writeln(ho_ten:25,' ',que_quan:15,' ',lop:8,' ',sbd:9);
p := p^.Next;
end;
end;
procedure in_ds_lop(var l :con_tro);
var r,p: con_tro; found: boolean; lop: string[8]; ans: integer;
begin
writeln('nhap lop can in ds sv: '); readln(lop);
repeat
r:=nil;
p:= head;
found:= false;
while (p<> nil) and (not found) do
begin
if p^.lop=lop then found:=true
else r:=p; p:=p^.next; end;
if found then
begin
with p^ do writeln(ho_ten:25,' ',que_quan:15,' ',sbd:9);
p:=p^.next end;
until (found=false)

end;
procedure in_ds_theo_que(var l :con_tro);
var r,p: con_tro; found: boolean; que_quan: string[8]; ans: integer;
begin
writeln('nhap lop can in ds sv: '); readln(que_quan);
repeat
r:=nil;
p:= head;
found:= false;
while (p<> nil) and (not found) do
begin
if p^.lop= que_quan then found:=true
else r:=p; p:=p^.next; end;
if found then
begin
with p^ do writeln(ho_ten:25,' ',que_quan:15,' ',sbd:9);
p:=p^.next end;
until (found=false)
end;
procedure Chen_sv_Lan( var l: con_tro);
var q,p: con_tro; found: boolean; dem,k:byte;
begin
write('ban muon them sv Nguyen Thi Lan vao sau sv nao? nhap vi tri sv do: ');
readln(k);
if (k<1) or (k> length(l)) then writeln('vi tri ko hop le')
else
begin
k:=k+1;
begin
dem:=2;

p:=head; found:=false; begin
while dem<>k do
begin dem:=dem+1; p:=p^.next; end; end;
begin new(q);
with q^ do
begin
q^.ho_ten:= 'Nguyen Thi Lan';
q^.que_quan:= 'Ha Noi';
q^.lop:= 'TH1B';
q^.sbd:= 'TH103';
end;
q^.next:= p^.next; p^.next:= q;
end; end; end;
end;
procedure Chen_sv_Hanh( var l: con_tro);
var q,p: con_tro; found: boolean; dem,k:byte; aa : string;
begin
if head^.ho_ten<> 'aa' then writeln('khong the them sv Hanh vao danh sach vi danh sach
ko co sv aa') else
begin
writeln('hay an 1 de them sv nguyen thi hanh vao sau sv aa '); readln(k);
if k<>1 then writeln('ban da khong them sv Hanh vao sau sv aa')
else
begin
k:=k+1;
begin
dem:=2;
p:=head; found:=true; begin
while dem<>k do
begin dem:=dem+1; p:=p^.next; end; end;

begin new(q);
with q^ do
begin
q^.ho_ten:= 'Nguyen Thi Hanh';
q^.que_quan:= 'Ha Giang';
q^.lop:= 'TH1A';
q^.sbd:= 'TH10';
end;
q^.next:= p^.next; p^.next:= q; end; end; end;
end; end;
procedure Chen_sv_thai_binh( var l: con_tro);
var q,p: con_tro; found: boolean; dem,k:byte; thaibinh: string;
begin
if head^.que_quan<> 'thaibinh' then writeln('khong the them sv an vao sau sv o dau ds vi
dau ds ko co sv que thai binh')
else
begin
writeln('hay an 1 de them sv Tran Dang An vao sau sv que thai binh '); readln(k);
if k<>1 then writeln('ban da khong them sv Tran Dang An vao sau sv dau ds co que
thai binh ')
else
begin
k:=k+1;
begin
dem:=2;
p:=head; found:=true; begin
while dem<>k do
begin dem:=dem+1; p:=p^.next; end; end;
begin new(q);
with q^ do

begin
q^.ho_ten:= 'Tran Dang An';
q^.que_quan:= 'ha tay';
q^.lop:= 'TH1B';
q^.sbd:= 'th100';
end;
q^.next:= p^.next; p^.next:= q;
end; end; end; end; end;
procedure xoa_pt_cuoi(var l: con_tro);
var r, p: con_tro;
begin
p^.next:=nil;
l^.next:=p^.next;
begin
l:=r;
l^.next:=nil; dispose(p);
end;
end;
procedure xoa_pt_thu_k(var l: con_tro; k: byte);
var p,m: con_tro; dem: integer;
begin
writeln('nhap vi tri can xoa: '); readln(k);
if l=nil then writeln('danh sach rong')
else if k<length(l) then
begin
if k=1 then begin
p:=l;
l:=l^.next;
end else
begin

m:=l;
dem:=1;
while dem<> k-1 do
begin
m:=m^.next;
dem:=dem+1;
end;
p:=m^.next;
m^.next:=p^.next;
end;
dispose(p);
end;
end;
procedure xoa_sv_sbd_th67(var l: con_tro);
var q,r: con_tro; th67: string; found: boolean; ans: byte;
begin
r:=nil;
q:=head;
found:= false;
while (q<> nil) and (not found) do
begin
if q^.sbd= 'th67' then found:=true
else
begin r:=q;
q:=q^.next;
end;
begin
if found then begin
if q=head then head :=q^.next else r^.next:=q^.next;
if q^.next=NIL then l:=r; dispose(q);

end; end; end; if found= false then begin writeln('khong co sv nay trong ds de
xoa');
end; end;
procedure xoa_het_aa(var l: con_tro);
var r,p: con_tro; found: boolean;
begin
repeat
r:=nil;
p:=head;
found:=false;
while (p<> nil) and (not found) do
begin
if p^.ho_ten= 'aa' then found:= true
else
r:=p;
p:=p^.next;
if found then begin
if p=head then p:=p^.next else r^.next:=p^.next;
if p^.next= nil then l:=r; dispose(p); end; end;
until (found=false);
end;