đề thử 2009

Bai 1:
uses crt;
const so=['1'..'9'];
var a:string;
   i,tong,n,dem,code:integer;
begin
clrscr;
repeat
writeln('Nhap chuoi co it nhat 1 so nguyen duong:');readln(a);
dem:=0;
for i:=1 to length(a) do if a[i] in so then dem:=dem+1;
if dem=0 then writeln('Nhap thieu');
until dem>=1;
writeln('Chuoi do la:',a);
tong:=0;
for i:=1 to length(a) do if a[i] in so then
begin
    val(a[i],n,code);
    tong:=tong+n;
end;
writeln('Tong cac so trong chuoi la:',tong);
readln;
end.

Bai 2:
uses crt;
var a1,b1,a2,b2,n,i:integer;
{-}
function ngay(thang,n:integer):integer;
begin
if n mod 4=0 then
case thang of
1,3,5,7,8,10,12:ngay:=31;
4,6,9,11:ngay:=30;
2:ngay:=29;
end
else
case thang of
1,3,5,7,8,10,12:ngay:=31;
4,6,9,11:ngay:=30;
2:ngay:=28;
end;
end;
procedure nhap(var a,b:integer);
begin
repeat
write('Nhap ngay:');readln(a);
write('Nhap thang:');readln(b);
if (b<=0) or (b>12) or (a<=0) or (a>ngay(b,n)) then writeln('Nhap Sai');
until (b>0) and (b<=12) and (a>0) and (a<=ngay(b,n));
end;
function w(var a1,b1,a2,b2,n:integer):integer;
var tong,i:integer;
begin
tong:=0;
if b1=b2 then
begin
if a1>a2 then tong:=a1-a2+1
else tong:=a2-a1+1;
end;
if b1<b2 then
begin
for i:=b1+1 to b2-1 do tong:=tong+ngay(i,n);
tong:=tong+(ngay(b1,n)-a1)+a2;
end;
if b1>b2 then
begin
for i:=b2+1 to b1-1 do tong:=tong+ngay(i,n);
tong:=tong+(ngay(b2,n)-a2)+a1;
end;
w:=tong;
end;
{-}
begin
clrscr;
write('Nhap nam:');readln(n);
writeln('~~~~~MOC 1~~~~~');
nhap(a1,b1);
writeln('~~~~~MOC 2~~~~~');
nhap(a2,b2);
writeln('Ngay ',a1,'/',b1,' va ngay ',a2,'/',b2,' cach nhau ',w(a1,b1,a2,b2,n),' ngay');
readln;
end.

Bai 3:
uses crt;
var a,uoc:array[1..100] of integer;
n,i,j:integer;
{-}
procedure dc(var a,b:integer);
var i:integer;
begin
i:=a;a:=b;b:=i;
end;
{-}
begin
clrscr;
write('Nhap phan tu day:');readln(n);
for i:=1 to n do
begin
write('a[',i,']:');readln(a[i]);
end;
for i:=1 to n do uoc[i]:=0;
for i:=1 to n do
for j:=1 to a[i] do if a[i] mod j=0 then uoc[i]:=uoc[i]+1;
for i:=1 to n-1 do for j:=i+1 to n do if uoc[i]>uoc[j] then
begin
dc(uoc[i],uoc[j]);dc(a[i],a[j]);
end;
write('Day sau sap xep la:');
for i:=1 to n do write(a[i]:5);writeln;
readln;
end.