Лабораторные (частично готовые)

uses crt;
var n, y, i, s, m : longint;
begin
 writeln ('vvedite n');
 readln(n);
 s:=s;
 for i:=1 to n do
  begin
   y:=1;
   for m:=1 to i do
    y:=y*i;
    s:=s+y;
  end;
 writeln('otvet - ', s);
 readkey;
end.

Const n=6;  {n=максимальное колличество цифр в числе}
      Cifra=['0'..'9'];
var chislo:array [1..n] of char;
    minChislo: array[1..n] of char;
    i,j,flag,k,m:integer;
    min,bufer:char;
begin
m:=0;
flag:=0;
writeln('Введите число: ');
 for i:= 1 to n do
   begin
    read(chislo[i]);
    if not (chislo[i] in Cifra) and (chislo[i]<>#10) and (chislo[i]<>#13) then
     begin
      readln;
      write('Ошибка');
      readln;
      halt;
     end;
 
    if (chislo[i]<>#10) and (chislo[i]<>#13) then
    inc(m);
   end;
 
 
{============================================================================}
for i:=1 to m-1 do    {Упорядочиваем цифры по возрастанию}
 for j:=i+1 to m do
    if chislo[i]>chislo[j] then
     begin
      bufer:=chislo[i];
      chislo[i]:=chislo[j];
      chislo[j]:=bufer;
     end;
 
{============================================================================}
for i:=1 to m do         {подсчет нулей}
  if chislo[i]='0' then
   inc(flag)
  else if  chislo[i]<>'0' then      {следущее число за нулями}
   begin
    min:=chislo[i];
    break;
   end;
{============================================================================}
 
j:=0;
for i:=flag+1 to m do
 if chislo[i]=min then
  begin
   inc(j);
   minChislo[j]:=chislo[i];
  end
 else if chislo[i]<>min then
  begin
    for k:=1 to flag do
     begin
      inc(j);
      minChislo[j]:=chislo[k];
     end;
   for k:=i to m do
    begin
     inc(j);
     minChislo[j]:=chislo[k];
    end;
 break;
 end;
{============================================================================}
readln;
write('Результат:');
for i:=1 to m do
 write(minChislo[i]);
 
readln;
end.

Var a,b,c,d,e : Integer;
    r : Integer;
 
Function op(op1, op2, znak : Integer):Integer;
Var Result : Integer;
Begin
     Case znak Of
          1 : Result := op1 + op2;
          2 : Result := op1 - op2;
          3 : Result := op1 * op2;
          4 : Result := round(op1 / op2);
     End;
     op := Result;
End;
 
Function zn(znak : Integer):Char;
Var Result : Char;
Begin
     Case znak Of
          1 : Result := '+';
          2 : Result := '-';
          3 : Result := '*';
          4 : Result := '/';
     End;
     zn := Result;
End;
 
 
Begin
     For a := 1 To 4 Do
         For b := 1 To 4 Do
             For c := 1 To 4 Do
                 For d := 1 To 4 Do
                     For e := 1 To 4 Do
                     Begin
                         r := op(op(op(op(op(1,2,a),3,b),4,c),5,d),6,e);
                         If r=35 Then
                            WriteLn ('(((((1',zn(a),'2)',zn(b),'3)',zn(c),'4)',zn(d),'5)',zn(e),'6)=',r);
                     End;
 
End.

uses crt;
var n, y, i, s, m : longint;
begin
clrscr;
 writeln ('Введите число n');
 readln(n);
 s:=s;
 for i:=1 to n do
  begin
   y:=1;
   for m:=1 to i do
    y:=y*i;
    s:=s+y;
  end;
 if s>32767 then
  Writeln('упс... произошло переполнение типа integer, а число n было вот такое - ', n);
 
 writeln('Ответ: ', s);
 readkey;
 {переполнение: integer n=6, longint n=11}
end.