高精度乘法 [复制链接]

谁会 高精度*高精度 的程序，用数组，要很精确的，谁来帮我一下。感激不尽！

program f;
type arraytype=array[1..10000] of integer;
var k,b,i:integer;
    ch:char;
    a:arraytype;
procedure time(var x:arraytype;y:integer);
var g,i:integer;
begin
for i:=1 to k+1 do
begin
a[k]:=a[k]*b+g;
a[k]:=a[k] mod 10;
g:=a[k] div 10;
end;
end;
begin
{assign(input,'f.in');
assign(output,'f.out');
reset(input);
rewrite(output); }
{while not eoln do
begin          }
read(ch);
k:=0;
while (ch<>'d') do;
begin
k:=k+1;
a[k]:=ord(ch)-48;
read(ch);
end;
//end;
read(b);
time(a,b);
for i:=k+1 downto 1 do
if a<>0 then write(a);
close(input);
close(output);
end.

...

Procedure readdata(var int:arrtype);
    var ch:char; i,k:integer;
  Begin
    read(ch); k:=0;
    while (ch>='0') and (ch<='9') do
        begin k:=k+1;
        int[k]:=ord(ch)-ord('0');
                  read(ch)  end;    readln;
    if k<n then
      for i:=k downto 1 do
          begin
              int[n+i-k]:=int;  int:=0;
          end;
          end;
procedure add(var x:arrtype;y:integer);
    var k:integer;
  Begin
    g:=0;
    for k:=n downto 1 do
      begin s:=x[k]*y+g;
                x[k]:=s mod 10;
                g:=s div 10;
      end;
      end;
Procedure outdata(a:arrtype);
    var k:integer;
  Begin
    k:=1;
    while a[k]=0 do k:=k+1;
    while k<=n do
      begin write(a[k]); k:=k+1; end;
    writeln;
  end;
Begin
    for s:=1 to n do
      begin
        a[s]:=0;
      end;
  readdata(a);
  read(b);
  add(a,b);
  outdata(a);
End.