Sinh viên:Dương Anh Vũ
Lớp Sp Tin 2
1)
uses crt;
type
tree=^node;
node=record
info:integer;
left:tree;
right:tree;
end;
var
root:tree;x,tong,chon,sonut:integer;ch:char;
procedure Init(var root:tree);
begin
new(root);
root:=nil;
end;
procedure Add(var root:tree;x:integer);
var p,q,l:tree;
begin
new(p);
p^.info:=x;
p^.left:=nil;
p^.right:=nil;
if(root=nil)then
root:=p
else
begin
new(q);new(l);
q:=root;

Sum:=tong;
end;
function Find(root:tree;x:integer):boolean;
var p:tree;
begin
new(p);
p:=root;
while(p<>nil)and(p^.info<>x)do
begin
if(x>p^.info)then
p:=p^.right
else p:=p^.left;
end;
if(p=nil)then Find:=false
else Find:=true;
end;
procedure Delete(var root:tree;x:integer);
var p,q,l,r,t:tree;
begin
new(p);new(q);
q:=nil;
p:=root;
while(p<>nil)and(p^.info<>x)do
begin
q:=p;
if(x>p^.info)then
p:=p^.right
else p:=p^.left;
end;
if(p^.info=x)then

if(root<>nil)then
begin
So_node:=So_Node(root^.left,sonut);
So_node:=So_node(root^.right,sonut);
if(root^.left=nil)and(root^.right=nil)then
inc(sonut);
end;
So_node:=sonut;
end;}
procedure So_Node(root:tree;var sonut:integer);
begin
if(root<>nil)then
begin
So_Node(root^.left,sonut);
So_node(root^.right,sonut);
if(root^.left=nil)and(root^.right=nil)then
inc(sonut);
end;
end;
begin
clrscr;
init(root);
repeat
writeln(' MENU');
writeln(' 1_Them ');
writeln(' 2_Tim ');
writeln(' 3_Xoa ');
writeln(' 4_TinhTong');
writeln(' 5_InCay ');
writeln(' 6_So_Nut_La');

6:begin
sonut:=0;
so_node(root,sonut);
writeln('so nut la:',sonut);
end;
end
until chon=7;
end.
2)
Program GiaiThua;
Uses crt;
Var n: byte;
Function Giaithua(n:byte):longint;
Begin
If (n<=1) then
Giaithua:=1
Else
Giaithua:= Giaithua(n-1)*n;
End;
BEGIN
Clrscr;
Write('Nhap n: '); Readln(n);
Write(n,'!= ',Giaithua(n));
Readln;
END.

Program Fibonaci2;
Uses crt;
Var n: byte;
Function Fibonaci(n:byte):longint;

Write('Nhap so dia: '); Readln(n);
Write('Nhap ten thap 1: '); Readln(A);
Write('Nhap ten thap 2: '); Readln(B);
Write('Nhap ten thap 3: '); Readln(C);
writeln('Quy trinh chuyen dia nhu sau:');
ThapHN(n,A,B,C);
Readln;
END.

program TextFile;
uses crt;
const filename='C:\Va nban.txt';
var f: text;
s: string;
chon: char;
dem: byte;
function demtu(s: string):integer;
var i,d: integer;
begin
d:=1;
for i:=1 to length(s) do
if (s[i]=' ') and (s[i+1] <> ' ') then
d:=d+1;
demtu:=d;
end;
begin
clrscr;
assign(f,filename);
{rewrite(f);
repeat

var i,k:byte;
begin
while s[1]=space do
delete(s,1,1);
while s[length(s)]=space do
delete(s,length(s),1);
repeat
k:=pos(space+space,s);
if k>0 then
delete(s,k,1);
until k=0;
s[1]:=upcase(s[1]);
for i:=2 to length(s) do
if s[i] in ['A' 'Z'] then
s[i]:=chr(ord(s[i])+32);
for i:=1 to length(s) do
if (s[i]=space) then
s[i+1]:=upcase(s[i+1]);
ChuanHoa:=s;
end; BEGIN
clrscr;
write('Nhap chuoi HoTen can chuan hoa: ');readln(s);
write('Chuoi sau khi chuan hoa: ',ChuanHoa(s));
assign(f,'D:\hoten.txt');
rewrite(f);
writeln(f,s);
close(f);
readln;
END.


clrscr;
until upcase(chon)='N';
end;
procedure GhiDL(var f:F;A:DanhSach;n:integer);
var i:integer;
begin
rewrite(f);
for:=1 to n do
write(f,A[i]);
end;
procedure DocDL(var f:F;A:DanhSach);
var n,i:integer;
temp:HangHoa;
begin
reset(f);
n:=0;
while not eof(f) n do
begin
n:=n+1;
read(f,A[i]);
end;
close(f);
for i:=1 to (n-1) do
for j:=i+1 to n do
if A[i].MaHang>A[j].MaHang then
begin
temp:=A[i];
A[i]:=A[j];
A[j]:=temp;
end;

close(f);
readln;
END.