求求各位啦!!

如果不能修改就发源程序上来也可以！谢！

高精度加法程序如下： 

program HighPrecision1_Plus;
const
  fn_inp='hp1.inp';
  fn_out='hp1.out';
  maxlen=100;  { max length of the number }
type
  hp=record
       len:integer; { length of the number }
       s:array[1..maxlen] of integer
       { s[1]   is the lowest  position
         s[len] is the highest position }
     end;
var
  x:array[1..2] of hp;
  y:hp; { x:input ; y:output } 

  procedure PrintHP(const p:hp);
  var i:integer;
  begin
    for i:=p.len downto 1 do write(p.s[i]);
  end; 

  procedure init;
  var
    st:string;
    j,i:integer;
  begin
    assign(input,fn_inp);
    reset(input);
    for j:=1 to 2 do
    begin
      readln(st);
      x[j].len:=length(st);
      for i:=1 to x[j].len do { change string to HP }
        x[j].s[i]:=ord(st[x[j].len+1-i])-ord('0');
    end;
    close(input);
  end; 

  procedure Plus(a,b:hp;var c:hp); { c:=a+b }
  var i,len:integer;
  begin
    fillchar(c,sizeof(c),0);
    if a.len>b.len then len:=a.len  { get the bigger length of a,b }
                   else len:=b.len;
    for i:=1 to len do { plus from low to high }
    begin
      inc(c.s[i],a.s[i]+b.s[i]);
      if c.s[i]>=10 then
      begin
        dec(c.s[i],10);
        inc(c.s[i+1]); { add 1 to a higher position }
      end;
    end;
    if c.s[len+1]>0 then inc(len);
    c.len:=len;
  end; 

  procedure main;
  begin
    Plus(x[1],x[2],y);
  end; 

  procedure out;
  begin
    assign(output,fn_out);
    rewrite(output);
    PrintHP(y);
    writeln;
    close(output);
  end; 

  begin
    init;
    main;
    out;
  end. 

高精度减法程序如下： 

program HighPrecision2_Subtract;
const
  fn_inp='hp2.inp';
  fn_out='hp2.out';
  maxlen=100;  { max length of the number }
type
  hp=record
       len:integer; { length of the number }
       s:array[1..maxlen] of integer
       { s[1]   is the lowest  position
         s[len] is the highest position }
     end;
var
  x:array[1..2] of hp;
  y:hp; { x:input ; y:output }
  positive:boolean; 

  procedure PrintHP(const p:hp);
  var i:integer;
  begin
    for i:=p.len downto 1 do write(p.s[i]);
  end;

  procedure init;
  var
    st:string;
    j,i:integer;
  begin
    assign(input,fn_inp);
    reset(input);
    for j:=1 to 2 do
    begin
      readln(st);
      x[j].len:=length(st);
      for i:=1 to x[j].len do { change string to HP }
        x[j].s[i]:=ord(st[x[j].len+1-i])-ord('0');
    end;
    close(input);
  end;

  procedure Subtract(a,b:hp;var c:hp); { c:=a-b, suppose a>=b }
  var i,len:integer;
  begin
    fillchar(c,sizeof(c),0);
    if a.len>b.len then len:=a.len  { get the bigger length of a,b }
                   else len:=b.len;
    for i:=1 to len do { subtract from low to high }
    begin
      inc(c.s[i],a.s[i]-b.s[i]);
      if c.s[i]<0 then
      begin
        inc(c.s[i],10);
        dec(c.s[i+1]); { add 1 to a higher position }
      end;
    end;
    while(len>1) and (c.s[len]=0) do dec(len);
    c.len:=len;
  end;

  function Compare(const a,b:hp):integer;
  {
    1 if a>b
    0 if a=b
   -1 if a<b
  }
  var len:integer;
  begin
    if a.len>b.len then len:=a.len  { get the bigger length of a,b }
                   else len:=b.len;
    while(len>0) and (a.s[len]=b.s[len]) do dec(len);
    { find a position which have a different digit }
    if len=0 then compare:=0 { no difference }
             else compare:=a.s[len]-b.s[len];
  end;

  procedure main;
  begin
    if Compare(x[1],x[2])<0 then positive:=false
                            else positive:=true;
    if positive then Subtract(x[1],x[2],y)
                else Subtract(x[2],x[1],y);
  end;

  procedure out;
  begin
    assign(output,fn_out);
    rewrite(output);
    if not positive then write('-');
    PrintHP(y);
    writeln;
    close(output);
  end;

  begin
    init;
    main;
    out;
  end.

高精度乘高精度 程序如下: 

program HighPrecision4_Multiply2;
const
  fn_inp='hp4.inp';
  fn_out='hp4.out';
  maxlen=100;  { max length of the number }
type
  hp=record
       len:integer; { length of the number }
       s:array[1..maxlen] of integer
       { s[1]   is the lowest  position
         s[len] is the highest position }
     end;
var
  x:array[1..2] of hp;
  y:hp; { x:input ; y:output }

  procedure PrintHP(const p:hp);
  var i:integer;
  begin
    for i:=p.len downto 1 do write(p.s[i]);
  end;

  procedure init;
  var
    st:string;
    j,i:integer;
  begin
    assign(input,fn_inp);
    reset(input);
    for j:=1 to 2 do
    begin
      readln(st);
      x[j].len:=length(st);
      for i:=1 to x[j].len do { change string to HP }
        x[j].s[i]:=ord(st[x[j].len+1-i])-ord('0');
    end;
    close(input);
  end;

  procedure Multiply(a,b:hp;var c:hp); { c:=a+b }
  var i,j,len:integer;
  begin
    fillchar(c,sizeof(c),0);
    for i:=1 to a.len do
      for j:=1 to b.len do
      begin
        inc(c.s[i+j-1],a.s[i]*b.s[j]);
        inc(c.s[i+j],c.s[i+j-1] div 10);
        c.s[i+j-1]:=c.s[i+j-1] mod 10;
      end;
    len:=a.len+b.len+1;
    {
      the product of a number with i digits and a number with j digits
      can only have at most i+j+1 digits
    }
    while(len>1)and(c.s[len]=0) do dec(len);
    c.len:=len;
  end;

  procedure main;
  begin
    Multiply(x[1],x[2],y);
  end;

  procedure out;
  begin
    assign(output,fn_out);
    rewrite(output);
    PrintHP(y);
    writeln;
    close(output);
  end;

  begin
    init;
    main;
    out;
  end.

高精度除以高精度程序如下:

program HighPrecision4_Multiply2;
const
  fn_inp='hp6.inp';
  fn_out='hp6.out';
  maxlen=100;  { max length of the number }
type
  hp=record
       len:integer; { length of the number }
       s:array[1..maxlen] of integer
       { s[1]   is the lowest  position
         s[len] is the highest position }
     end;
var
  x:array[1..2] of hp;
  y,w:hp; { x:input ; y:output }

  procedure PrintHP(const p:hp);
  var i:integer;
  begin
    for i:=p.len downto 1 do write(p.s[i]);
  end;

  procedure init;
  var
    st:string;
    j,i:integer;
  begin
    assign(input,fn_inp);
    reset(input);
    for j:=1 to 2 do
    begin
      readln(st);
      x[j].len:=length(st);
      for i:=1 to x[j].len do { change string to HP }
        x[j].s[i]:=ord(st[x[j].len+1-i])-ord('0');
    end;
    close(input);
  end;

  procedure Subtract(a,b:hp;var c:hp); { c:=a-b, suppose a>=b }
  var i,len:integer;
  begin
    fillchar(c,sizeof(c),0);
    if a.len>b.len then len:=a.len  { get the bigger length of a,b }
                   else len:=b.len;
    for i:=1 to len do { subtract from low to high }
    begin
      inc(c.s[i],a.s[i]-b.s[i]);
      if c.s[i]<0 then
      begin
        inc(c.s[i],10);
        dec(c.s[i+1]); { add 1 to a higher position }
      end;
    end;
    while(len>1) and (c.s[len]=0) do dec(len);
    c.len:=len;
  end;

  function Compare(const a,b:hp):integer;
  {
    1 if a>b
    0 if a=b
   -1 if a<b
  }
  var len:integer;
  begin
    if a.len>b.len then len:=a.len  { get the bigger length of a,b }
                   else len:=b.len;
    while(len>0) and (a.s[len]=b.s[len]) do dec(len);
    { find a position which have a different digit }
    if len=0 then compare:=0 { no difference }
             else compare:=a.s[len]-b.s[len];
  end;


  procedure Multiply10(var a:hp); { a:=a*10 }
  var i:Integer;
  begin
    for i:=a.len downto 1 do
      a.s[i+1]:=a.s[i];
    a.s[1]:=0;
    inc(a.len);
    while(a.len>1) and (a.s[a.len]=0) do dec(a.len);
  end;

  procedure Divide(a,b:hp;var c,d:hp); { c:=a div b ; d:=a mod b }
  var i,j,len:integer;
  begin
    fillchar(c,sizeof(c),0);
    len:=a.len;
    fillchar(d,sizeof(d),0);
    d.len:=1;
    for i:=len downto 1 do
    begin
      Multiply10(d);
      d.s[1]:=a.s[i]; { d:=d*10+a.s[i] }
      { c.s[i]:=d div b ; d:=d mod b; }
      { while(d>=b) do begin d:=d-b;inc(c.s[i]) end }
      while(compare(d,b)>=0) do
      begin
        Subtract(d,b,d);
        inc(c.s[i]);
      end;
    end;
    while(len>1)and(c.s[len]=0) do dec(len);
    c.len:=len;
  end;

  procedure main;
  begin
    Divide(x[1],x[2],y,w);
  end;

  procedure out;
  begin
    assign(output,fn_out);
    rewrite(output);
    PrintHP(y);
    writeln;
    PrintHP(w);
    writeln;
    close(output);
    end;

  begin
    init;
    main;
    out;
  end.

狂谢，就是太长了

6楼的悍!
我只有吃一点肉汤了T_T!
N!问题:
program njin(input,output);
var
  s:array[1..1000] of longint;  n,le,i,j,c,sum:longint;  f:integer;
begin
assign(input,'njie.in');reset(input);  assign(output,'njie.out');rewrite(output);  readln(n);
IF n = 1 THEN begin write(1,' ','F'); close(input);close(output)；exit end;
s[1]:= 1; le:= 1;
FOR i:= 2 TO n do
   begin
   c:= 0;
   FOR j:= 1 TO le do
      begin  sum:= s[j] * i + c; c:= sum div 10; s[j]:= sum MOD 10 end;
   IF c > 0 THEN
     WHILE c <> 0 DO  begin j:= j + 1;  s[j]:= c MOD 10; c:= c div 10 end;
   le:=j;
   end;
sum:= 0;
FOR i:= 1 TO le do  sum:= sum + s[i];
f:= -1;
FOR i:= 2 TO trunc(sqrt(sum)) do
    IF sum MOD i = 0 THEN begin f:= 0; break end;
IF f = -1 THEN write(sum,' ', 'T') ELSE write(sum,' ', 'F');
close(input);close(output)
END.

好长