program ct;

uses crt;

var A:array[1..2009] of boolean;

      i,j,n,d:integer;

begin clrscr;

   for i:=1 to 2009 do

     A[i]:=True;

    n:=1; j:=2009;

   while j>1 do

     begin

        d:=0;

        while d<612 do

          begin

             if A[n] then d:=d+1;

             if d=612 then A[n]:=False;

             if n=2009 then n:=1

                             else n:=n+1;

          end;

        j:=j-1;

     end;

   for i:=1 to 2009 do

     if A[i] then n:=i;

   writeln('So con lai la: ',n);

readln;

end.

Học tốt!

uses crt;var i,j,k,n,t:integer;    s,ss:string;  function nt(t:integer):boolean;   var c:integer;   begin   nt:=false;   if t<2 then exit;   for c:=2 to trunc(sqrt(t)) do    if t mod c=0 then exit;    nt:=true;   end;  begin  repeat   write('n,k=');   readln(n,k);  until(k<=n)and(1<=n)and(n<=50);   n:=n-1;   s:='2';   i:=3;   while (n>0)do    begin    if nt(i)=true then       begin       n:=n-1;       str(i,ss);       s:=s+ss;       end;       i:=i+2;    end;    writeln(s);    ss:=s;    n:=0;    i:=1;    s:=s+'1';  while (n<k)and(i<>length(s)) do   begin    if s[i]>s[i+1] then       begin        delete(s,i,1);        n:=n+1;        i:=1;       end    else i:=i+1;   end;   delete(s,length(s),1);   while n<k do         begin         delete(s,1,1);         n:=n+1;         end;   if s='' then writeln('0') else writeln(s);  n:=0;  i:=1;  while (n<k)and(i<>length(ss)) do   begin    if ss[i]<ss[i+1] then       begin        delete(ss,i,1);        n:=n+1;        i:=1;       end    else i:=i+1;  end;   while n<k do      begin      n:=n+1;      delete(ss,length(ss),1);      end; if ss='' then writeln('0') else writeln(ss);  readln;