100 факториалов - 2 в степени 100

{$N+}
program Project2;
uses
  crt;
  var p,p1:extended;
  n:integer;
 
function Factorial(n:integer):extended;
var i:integer;
 p:extended;
begin
p:=1;
if(n = 0 ) then
    Factorial := 1
else
 for i:=1 to n do
 begin
   p:= p*i;
 end;
  Factorial := p;
end;
function Pow(a:real;n:integer):extended;
var i:integer;
 p:extended;
begin
p:=1;
if(n = 0 ) then
    Pow := 1
else
 for i:=1 to n do
 begin
   p:= p*a;
 end;
  Pow := p;
end;
begin
  write('n=');readln(n);
  p:=Factorial(n);
  writeln(n,'!= ',p);
  p1:=Pow(2,100);
  writeln('2^100 = ',p1);
  p := p - p1;
  writeln(n,'! - 2^100 = ',p);
  readln;
end.

program Project2;
uses
  crt;
  var
  p,p1:real;
  n:integer;
  function Factorial(n:integer):real;
var i:integer;
 p,p1:real;
begin
p:=1;
if(n = 0 ) then
    Factorial := 1
else
 for i:=1 to n do
 begin
   p:= p*i;
 end;
  Factorial := p;
end;
function Pow(a:real;n:integer):real;
var i:integer;
 p:real;
begin
p:=1;
if(n = 0 ) then
    Pow := 1
else
 for i:=1 to n do
 begin
   p:= p*a;
 end;
  Pow := p;
end;
begin
  write('n=');readln(n);
  p:=Factorial(n);
  writeln(n,'!= ',p);
  p1:=Pow(2,100);
  writeln('2^100 = ',p1);
  p := p+p1;
  writeln(n,'! + 2^100 = ',p);
  readln;
end.

uses crt;
const max=28;
var k:array[1..max]of longint;
var x:array[0..90000] of byte;
m,l:longint;
i,j,n:integer;
p,s,otv:string;
a:longint;
 
 
 
procedure f;
var i:longint;
    carry,db:byte;
begin
 carry:=0;
 for i:=1 to a do
  begin
   db:=x[i]*2+carry;
   x[i]:=db mod 10;
   carry:=db div 10;
  end;
 if carry>0 then
  begin
   inc(a);
   x[a]:=carry;
  end;
end;
 
 
 
var v:longint;
    q:longint;
begin
  write('Â êàêóþ ñòåïåíü âîçâîäèì 2 ^ ');
 readln(v);
 a:=1;
 x[1]:=1;
 for q:=1 to v do
  f;
 for q:=a downto 1 do
 
  write(x[q]);
 
 writeln;
 
 
 begin
for i:=1 to max do k[ i]:=0; l:=1000000; s:=''; write('Ââåäèòå ÷èñëî äëÿ çíà÷åíèÿ ôàêòîðèàëà: '); readln(n); k[1]:=1;
for i:=1 to n do begin m:=0; for j:=1 to max do begin k[j]:=k[j]*i+m; m:=k[j] div l; k[j]:=k[j] mod l end end;
for j:=max downto 1 do begin str(k[j]:6,p); s:=s+p end; for j:=1 to length(s) do if s[j]=' ' then s[j]:='0';
for j:=1 to length(s) do if s[j]>'0' then begin s:=copy(s,j,length(s)-j+1); break end;
j:=1; while(s[j]='0')do begin s[j]:=' '; inc(j) end; writeln; writeln(s); readln ;
end;
 
 
end;
end.

uses crt;
var a:array [1..158] of byte; i,l,j:byte;
b:array [1..32] of byte;
procedure vm(t:byte; var a:array of byte; var l:byte);
var s,ost:integer; i,j:byte;
begin
i:=1; l:=1; ost:=0; a[1]:=t;
repeat
inc(i);
for j:=1 to l do
   begin
   case t of
   1:s:=a[j]*i+ost; {факториал}
   2:s:=a[j]*2+ost; {степень}
   end;
   if s>9 then
      begin
      a[j]:=s mod 10;
      ost:=s div 10;
      end
   else
      begin
      a[j]:=s;
      ost:=0;
      end;
   end;
if ost<>0 then
   repeat
   inc(l);
   a[l]:=ost mod 10;
   ost:=ost div 10;
   until ost=0;
until i=100;
end;
procedure raz(a,b:array of byte; l:byte; var c:array of byte);
var j:byte;
begin
i:=0;
repeat
inc(i);
if a[i-1]>=b[i] then a[i-1]:=a[i-1]-b[i] else
   begin
   a[i-1]:=a[i-1]+10-b[i];
   j:=i;
   while a[j]=0 do
      begin
      a[j]:=9;
      inc(j);
      end;
   dec(a[j]);
   end;
until i=l;
for i:=0 to l do c[i]:=a[i];
end;
begin
clrscr;
vm(2,b,l); {2^100}
vm(1,a,j); {100!}
raz(a,b,l,a); {разность}
write('100!-2^100= ');
for j:=j downto 1 do write(a[j]);
readkey;
end.

{ программа вычисляет 2 в степени d. }
 
uses crt; 
var
  A, B: array[0..100000]of integer;       
  j, K, i, c, D, N, M: integer;
 
begin
  //clrscr;
  write('Введите показатель степени:  ');
  read(D);
  A[1] := 1;
  M := 1;
  N := D;
  for j := 1 to N do
  begin
    c := 0;
    for i := M downto 1 do
    begin
      B[i] := (2 * A[i] + c) mod 10; c := (2 * A[i] + c) div 10;
    end;
    if c > 0 then
    begin
      A[1] := c;
      for i := 1 to M do A[i + 1] := B[i]; 
      inc(M);
    end
    else
    for i := 1 to M do A[i] := B[i];
  end;
  writeln;
  writeln('  2 в степени ', D, ':');
  for i := 1 to M do write(A[i]);
  writeln;
  writeln;
  writeln('Количество цифр числа: ', M);
  writeln;
  textcolor(red);
  readln;
end.