会编程的进!Pascal关于高精度计算的题目!谢谢!

var
f,s:array[1..100] of integer;
i,j,k,h,l:longint;
begin
read(n);
fillchar(f,sizeof(a),0);
fillchar(s,iszeof(b),0);
f[1]:=1;
for i:=1 to n do begin
k;=0;
for j:=1 to 100 do
begin
h:=f[j]*i+k;
f[j]:=h mod 10;
k:=h div 10;
end;
k:=0;
for j:=1 to 100 do
begin
h:=s[j]+f[j]+k;
s[j]:=h mod 10;
k:=h div 10;
end;
end;
l:=100;
while s[l]=0 do
l:=l-1;
for i:=l downto 1 do
write(s[i]);
writeln;
end.

上机调试正确的,但是我认为可以有别的办法把?当初看有的书上讲过这个题目,好象不是我这么多while出来的.如下:
program lzj;
var
i,j,n:integer;
a,b:array[1..100001]of integer;
begin
read(n);
a[1]:=1;
for i:=1to n do
begin
j:=1;
while a[j]<>0 do
begin
a[j]:=a[j]*i;
j:=j+1;
end;
j:=1;
while a[j]<>0 do
begin
a[j+1]:=a[j+1]+a[j]div 10;
a[j]:=a[j]mod 10;
j:=j+1;
end;
j:=1;
while a[j]<>0 do
begin
b[j]:=b[j]+a[j];
j:=j+1;
end;
j:=1;
while b[j]<>0 do
begin
b[j+1]:=b[j+1]+b[j]div 10;
b[j]:=b[j]mod 10;
j:=j+1;
end;
end;
for i:=1to j-1 do
write(b[i]);
end.