cấp trường đề số 5

Bài 1 : Viết chương trình tạo ngẫu nhiên 10 số chẵn. Sắp xếp các số này theo thứ tự giảm dần.
Bài 2 : Viết chương trình nhập vào một xâu gồm chữ và số. Hãy tính tổng các số trong chuỗi.
Bài 3 : Nhập vào số tự nhiên N. In ra màn hình chữ số lớn nhất trong N và số đảo ngược của N.
Bài 4 : Số siêu nguyên tố là số mà khi bỏ một số tùy ý các chữ số bên phải của nó thì phần còn lại vẫn tạo thành một số nguyên tố. VD: 7331 là số siêu nguyên tố vì 7331; 733; 73 và 7 đều là số nguyên tố.
Viết chương trình nhập vào nguyên dương N (N<10). In ra màn hình tất cả các số siêu nguyên tố có N chữ số.
Bài 5 : Cặp số hữu nghị là cặp số mà số này bằng tổng các ước của số kia và ngược lại. Lập trình in ra các cặp số hữu nghị từ 1 đến 10000.
Lưu ý: Mỗi số không là ước của chính nó (trừ số 1)
Bài 6 : Gọi abcd  là một số có 4 chữ số.
Viết chương trình tìm mọi số có 4 chữ số sao cho:  abcd = (ab+cd)²
Bài 7 : Nhập từ bàn phím 2 số nguyên dương có giá trị không quá 65000. In ra màn hình ƯCLN và BCNN của hai số đó. Đồng thời in ra tất cả các ước chung của chúng.
Bài 8 : Viết chương trình nhập từ bàn phím một xâu có lẫn vào một số có 3 chữ số, VD: ‘pas123cal’. Nếu nhập dữ kiện sai, cho phép nhập lại. Kiểm tra và cho biết số đó có phải là số nguyên tố không.

Siêu nguyên tố đêy!!!Max ngắn

Code:

uses crt;
var a,b,c,i,j,k,h,n:integer; s:string;
function nt(a:integer):boolean;
var i:integer;
begin
i:=2;
while a mod i<>0  do i:=i+1;
if i=a then nt:=true else nt:=false;
end;
{_}
function snt(a:integer):boolean;
var i,j,k,h:integer;
    s:string;
begin
str(a,s);
snt:=true;
for i:=1 to length(s) do
if nt(a)=false then snt:=false else a:=a div 10;
end;
{-}
begin
clrscr;
write('nhap so chu so can tim:');readln(n);
for i:=1 to n do
    begin
         k:=k*10;
         h:=h*10;
    end;
k:=k div 10;
h:=h-1;
for i:=k to h do if snt(i)=true then writeln(i:3);
readln;
end.

Bài 4 em xuất đc 5 chữ số không biết sao tới số 6 bị lỗi.Ad sửa giúp  
function kt(n:longint):boolean;
var i:longint;
begin
     kt:=true;
     for i:=2 to trunc(sqrt(n)) do
     if n mod i=0 then kt:=false;
     if n<2 then kt:=false;
end;
var n,i,d,t1,t2:longint;
begin
     write('nhap n:');readln(n);
     t1:=1;
     for i:=1 to n-1 do t1:=t1*10;
     t2:=t1*10-1;
     writeln('cac so sieu ngto:');
     for i:=t1 to t2 do
         begin
              n:=i;
              while kt(n)=true do n:=n div 10;
              if n=0 then
                         begin
                              write(i:9);
                              d:=d+1;
                         end;
         end;
         writeln;
         writeln('co',d,' so sieu ngto');
readln;
end.

Bạn có thể kết bạn với mình trên fb để mình giúp đỡ tốt hơn.
Link fb: fb.com/100009198524516