t[1] := 0;
for N:=2 to 1000 do t[N] := 1;
for N:=3 to 1000 do
    begin
        for i:=2 to (N div 2) do
            if (N mod i = 0) then
                begin
                    t[N] := t[N-i] + i;
                    break;
                end;
        if t[N] = N then writeln(N);
    end;

nhập n từ bàn phím tìm các số hoàn hảo từ 1 -- > n
bài làm em như sau.. tuy nhiên sao nó vẫn nhập n xong chả in ra màn hình ji cả

Program HH;
var i,j,s,n : integer;
  begin
  write(' nhap n '); readln(n);
  s:=0;
 for i:=2 to n do
    begin
    for j:=1 to n-1 do
      begin
      if (i mod j = 0 ) then s:=s+j;
      end;
      if s=i then write(i:3);
end;
readln;
end.

Program HH;
var i,j,s,n : integer;
begin
  write(' nhap n '); readln(n);
 for i:=2 to n do
  begin
    s:=0;
    for j:=1 to n-1 do {Chỉ cần kiểm tra tới n/2 thì được rồi}
      begin
         if (i mod j = 0 ) then s:=s+j;
      end;
   if s=i then write(i:3);
  end;
readln;
end.

if a[max]<a[i] and max <> maxold then max:=i;

var
chan:boolean;
chan:=false;
for i:=1 to n do
if chan:=false then
if a[i] mod 2 = 0 then
begin
max:=i;
chan:=true;
end;
else
if a[i] mod 2 = 0 and a[max]<a[i] then max:=i;

s:=0;
soluongso:=0;
for i:=1 to n do if a[i] thỏa mãn điều kiện then
begin
s:=s+a[i];
inc(soluongso);

program timdaycon;
uses crt, dos;
type
	mang = array[1..100] of real;
var
	n, i, start, l , start1, l : byte;
	{khai bao them bien neu can}
begin
	{tu viet lay phan nhap du lieu nhe}
	start:=1;
	l:=0;
	start1:=1;
	l1:=0;
	for i:=1 to n - 1 do
		begin
			if a[i] > a[i+1] then
				begin
					if l1 > l then
						begin
							l:= l1;
							start:= start1;
						end;
					l1:= 0;
					start1:= i + 1;
				end
			else
				Inc(l1);
		end;
	{In du lieu}
	For i:= start to start + l do
		Writeln('a[', i, '] = ', a[i]);
	Readln;
end;