我靠，你怎么得出这么多结果？？

穷举，运行了4个半小时……

{$M 8192,0,0}
 uses dos;
 type p=array [1..4] of real;
 const
   prn:array [1..13] of string[3]
      =('A  ','2  ','3  ','4  ','5  ','6  ','7  ',
        '8  ','9  ','10 ','J  ','Q  ','K  ');
 var
   k1,k2,k3,k4:integer;
   n:real;c,m,t:longint;
   time0,time:real;
   k,b:p;
  function j24(k:p;answer:real):boolean;
    var
      i1,i2,j1,j2,k1,k2,k3:byte;
      kn:p;
      flag,goal:boolean;
    function t(a,b:real;c:byte):real;
    begin
      case c of
        1:t:=a+b;
        2:t:=a-b;
        3:t:=b-a;
        4:t:=a*b;
        5:if b<>0 then t:=a/b else flag:=false;
        6:if a<>0 then t:=b/a else flag:=false;
      end;
    end;
    procedure print;
      var
        sn:array[1..4]of string;
        sc:array[1..4]of byte;
        i,j:integer;
      function l(m,n:byte;c:byte):string;
        var
          temp,a,b:string;
          t:byte;
      begin
        a:=sn[m];b:=sn[n];
        if c in [3,6] then begin
          temp:=a;a:=b;b:=temp;
          t:=sc[m];sc[m]:=sc[n];sc[n]:=t;
        end;
        if sc[n]<=c then b:='('+b+')';
        if (sc[m]<4)and(c>3) then a:='('+a+')';
        if c in [3,6] then c:=c-1;
        case c of
          1:l:=a+'+'+b;
          2:l:=a+'-'+b;
          4:l:=a+'*'+b;
          5:l:=a+'/'+b;
        end;
      end;
    begin
      for i:=1 to 4 do
        if kn[i]<10 then begin
          sn[i]:=' '; sn[i,1]:=chr(48+round(kn[i]));
        end else begin
          sn[i]:='  ';
          sn[i,1]:=chr(48+round(kn[i]) div 10);
          sn[i,2]:=chr(48+round(kn[i]) mod 10);
        end;
      for i:=1 to 4 do sc[i]:=7;
      sn[i1]:=l(i1,j1,k1);sn[j1]:=sn[4];sc[j1]:=sc[4];sc[i1]:=k1;
      sn[i2]:=l(i2,j2,k2);sn[j2]:=sn[3];sc[j2]:=sc[3];sc[i2]:=k2;
      sn[ 1]:=l( 1, 2,k3);
      writeln(sn[1]);
      goal:=true;
    end;
  begin
    j24:=true;
    goal:=false;
    kn:=k;
    for i1:=1 to 3 do
     for j1:=i1+1 to 4 do
      for i2:=1 to 2 do
       for j2:=i2+1 to 3 do
        for k1:=1 to 6 do
         for k2:=1 to 6 do
          for k3:=1 to 6 do begin
            k:=kn;flag:=true;
            k[i1]:=t(k[i1],k[j1],k1);
            k[j1]:=k[4];
            k[i2]:=t(k[i2],k[j2],k2);
            k[j2]:=k[3];
            if flag and (abs(t(k[1],k[2],k3)-answer)<1E-6) then goal:=true;
            if goal then exit;
          end;
    j24:=false;
  end;
  function timer:real;
    var
      h,m,s,ss:word;
  begin
    gettime(h,m,s,ss);
    timer:=h*3600+m*60+s+ss/100;
  end;
  procedure cmd(command:string);
  begin
    Command := '/C ' + Command;
    SwapVectors;
    Exec(GetEnv('COMSPEC'), Command);
    SwapVectors;
    if DosError <> 0 then
      Writeln('Could not execute COMMAND.COM');
  end;
begin
  cmd('cls');
  write('得数：');
  readln(n);t:=0;m:=0;c:=0;
  time0:=timer;
  for k1:=1 to 49 do
   for k2:=k1+1 to 50 do begin
     cmd('cls');
     writeln('　　　已完成：',t/1225*1000:8:4,'‰。');
     write('　　已用时间：');
     if t<>0 then time:=timer-time0;
     if t<>0 then write(trunc(time/60):2,'分钟',time-trunc(time/60)*60:5:2,'秒。') else write('0。');
     writeln;
     write('预计剩余时间：约');
     if t<>0 then time:=(timer-time0)/(t/1225)-time;
     if t<>0 then write(trunc(time/60):2,'分钟',time-trunc(time/60)*60:5:2,'秒。') else write('正在估算……。');
     t:=t+1;
    for k3:=k2+1 to 51 do
     for k4:=k3+1 to 52 do begin
       k[1]:=(k1-1) mod 13+1;
       k[2]:=(k2-1) mod 13+1;
       k[3]:=(k3-1) mod 13+1;
       k[4]:=(k4-1) mod 13+1;
       if j24(k,n) then c:=c+1 else m:=m+1;
     end;
    end;
  cmd('cls');
  writeln('完成！总计用时：');
  time:=timer-time0;write(trunc(time/60):2,'分钟',time-trunc(time/60)*60:5:2,'秒。');
  writeln(n:4:0,':');
  writeln('               总计：',c+m:10);
  writeln('   有一个或多个答案：',c:10,' (',c/(c+m)*1000:2:6,'‰)');
  writeln('           没有答案：',m:10,' (',m/(c+m)*1000:2:6,'‰)');
  readln;
end.