1)

Program b1;

Var a:array[1..100] of integer;

      i,n,d,min:integer;

Function ngto(c:longint):boolean;

Var b:longint;

Begin

   If c<2 then ngto:=false else ngto:=true;

   For b:=2 to trunc(sqrt(c)) do

       if c mod b = 0 then

               begin

                     ngto:=false; break;

               end;

End;

Begin

  {---cau_a----}

   Writeln('Nhap n:');Readln(n);

   Writeln('Cac so trong day la: ');

   For i:=1 to n do

    Begin

       Write('a[',i,']=');Readln(a[i]);

    end;

    {---cau_b---}

For i:=1 to n do

   If ngto(a[i]) then d:=d+1;

writeln ('Co ',d,' so nt trong day');

{---cau_c---}

min:=a[1];

For i:=1 to n do

  If  a[i]<min then min:=a[i];

write ('So nho nhat la ',min);

Readln

End.

2)

Program b2;

Var s,s1:string;

      i:integer;

Begin

  write('Nhap xau : ');readln(s); 

  for i:= (length(s)) downto 1 do 

      S1:=S1+S[i];

  if (S1=S) then write('Xau doi xung') else writeln('Xau khong doi xung');

  write ('Xau sau khi in hoa la: ');

  For i:=1 to length(s) do

  s[i]:=upcase(s[i]);

  Write(s);

readln;

END.

#chúcbạnhọctốt

1,

uses crt;

var a:array[1..250] of longint;

i,j,n,dem:byte;

min,tam:longint;

function nt(x:longint):boolean;

var i:longint;

begin

     if x<2 then exit(false);

     for i:=2 to trunc(sqrt(x)) do

          if x mod i = 0 then exit(false);

     exit(true);

end;

begin

     clrscr;

     repeat

               writeln('n = ');readln(n);

     until (0<n) and (n<=250);

     for i:=1 to n do

          begin

                    write('a[',i,']= ');readln(a[i]);

          end;

     write('a, ');

     for i:=1 to n do

          begin

                    write(a[i],' ');

                    if nt(a[i])=true then inc(dem);

                    if a[i]<min then min:=a[i];

          end;

     writeln;

     writeln('b, Co ',dem,' so nguyen to trong day');

     writeln('c, GTNN= ',min);

     for i:=1 to n-1 do

          for j:=i+1 to n do

               if a[i]<a[j] then

                    begin

                              tam:=a[i];a[i]:=a[j];a[j]:=tam;

                    end;

     writeln('d, Day da sap xep:');

     for i:=1 to n do write(a[i],' ');

readln;

end.

2,

uses crt;

var st,s:string;

i:byte;

begin

     clrscr;

     readln(st);

     for i:=length(st) downto 1 do

          s:=s+st[i];

     if s=st then writeln('a, Xau doi xung')

          else writeln('a, Xau khong doi xung');

     for i:=1 to length(st) do

          st[i]:=upcase(st[i]);

     writeln('b, ',st);

readln;

end.