Здравствуйте, Архипова Светлана Анатольевна.
В приложении решение задачи о проверке числа на совершенство.

Приложение:
{
Проверить, является ли число совершенным
Справка: совершенное число - число равное сумме всех своих делителей
6 = 1 + 2 + 3
28 = 1 + 2 + 4 + 7 + 14
}
Uses
Crt;
Var
i, Num, Sum: Word;
begin
ClrScr;
Write('?Num: ');
Readln(Num);
Sum := 0;
{
До октября 2008 года найдено 46 совершенных чисел.
Все они ЧЕТНЫЕ.
}
if Not (Odd(Num)) then
for i:=1 to (Num div 2) do
if (Num mod i = 0) then
Sum := Sum + i;
if (Sum = Num) then
Write('Number ', Num, ' is perfect.')
else
Write('Sorry, number ', Num, ' is NOT perfect.');
readkey;
end.

Здравствуйте, Архипова Светлана Анатольевна.

Решение задач с матрицами приведено в приложении. Возможно, не слишком красивое, но, по крайней мере, работающее. Входной файл для программы должен содержать в первой строке число строк (столбцов) матрицы, причем матрица предполагается квадратной. Например:



Программа проверена в среде Borland Pascal 7.0. Не забудьте преобразовать исходный текст в кодировку DOS (CP-866) перед компиляцией.

Успехов!

Приложение:
program q176777;
uses crt;

{$R-} { отключаем проверку индексов }
type t_array = array[0..0] of word;
p_array = ^t_array;

{ чтение массива из файла }
function readArray( var n: word; var p: p_array; fname: string ) : boolean;
var f: text;
i, j, i_row: integer;
begin
readArray := false;
{$I-}
assign( f, fname );
FileMode := 0; { устанавливаем доступ "только для чтения" }
reset( f );
if IOResult = 0 then begin
readln( f, n ); { читаем число строк (= числу столбцов) }
if n > 1 then begin
getmem( p, n*n*sizeof(integer) ); { выделяем память для квадратной матрицы }
{ элемены матрицы в памяти будем располагать по строкам }
for i := 0 to n-1 do begin
i_row := i*n; { индекс начала i-той строки }
for j := 0 to n-2 do
read( f, p^[i_row + j] );
readln( f, p^[i_row + n-1] );
end;
if IOResult = 0 then
readArray := true;
end;
end;
{$I+}
close( f );
end;

procedure snake( p: p_array; n: word );
var
i, j, k, d, s: integer;
begin
d := 1;
for s := 0 to n-1 do begin
if d > 0 then i := 0 else i := s;
for k := 0 to s do begin
j := s-i;
write( p^[i*n + j]:3 );
i := i + d;
end;
d := -d;
end;
for s := n to 2*(n-1) do begin
if d > 0 then i := s-n+1 else i := n-1;
for k := s to 2*(n-1) do begin
j := s-i;
write( p^[i*n + j]:3 );
i := i + d;
end;
d := -d;
end;
end;

procedure diag( p: p_array; n: word );
var
i, j, s: integer;
begin
for s := 0 to n-1 do begin
for i := s downto 0 do begin
j := s-i;
write( p^[i*n + j]:3 );
end;
end;
for s := n to 2*(n-1) do begin
for i := n-1 downto s-n+1 do begin
j := s-i;
write( p^[i*n + j]:3 );
end;
end;
end;

var fname: string;
n: word;
p: p_array;
ch : char;

begin
clrscr;
while true do begin
writeln( #13#10#10'Преобразовать квадратную матрицу в одномерный массив:' );
writeln( '1 - элементы записаны змейкой' );
writeln( '2 - элементы записаны по диагоналям' );
writeln( '-----------------------------------' );
writeln( '0 - выход из программы' );
repeat
ch := readkey;
until ch in ['0'..'2'];
if ch = '0' then exit;

write( #13#10'Введите имя файла: ' );
readln( fname );

if readArray( n, p, fname ) then begin
case ch of
'1': snake( p, n );
'2': diag( p, n );
end;
freemem( p, n*n*sizeof(integer) );
end;
end;
end.