Pascal几个问题

1.
program gds;
var su,kk:array[1..100000] of longint;
a:char;
i,j,n,m,k,sum,p:longint;
procedure work1;
var i,j:longint;
begin
for i:=1 to k-1 do
begin
for j:=1 to k-i do
su[i]:=su[i]*n;
inc(sum,su[i]);
end;
sum:=sum+su[k];
end;
function doo(a:char):byte;
begin
if ord(a)>=65 then
exit(ord(a)-55) else
exit(ord(a)-48);
end;
begin
assign(input,'work1.in');reset(input);
assign(output,'work1.out');rewrite(output);
readln(n);
while not eoln do
begin
read(a);
inc(k);
inc(p);
su[k]:=doo(a);
kk[k]:=doo(a);
end;
if n<>10 then work1 else
begin
for i:=k-1 downto 1 do
for j:=1 to i-1 do
sum:=sum+su[i]*10;
sum:=sum+su[k];
end;
readln(m);
fillchar(su,sizeof(su),0);
k:=0;
write('(');
for i:=1 to p do
write(kk[i]);
write(')',n,'=(');
if m=10 then
write(sum)
else
begin
while sum<>0 do
begin
inc(k);
su[k]:=sum mod m;
sum:=sum div m
end;
for i:=k downto 1 do
begin
if su[i]>=10 then
write(chr(su[i]+55))
else
write(su[i]);
end;
end;
write(')',m);
writeln;
close(input);
close(output);
end.
2.
program gds;
var st:string;
x,y:array[0..251]of integer;
i,j,l1,l2:integer;
begin
assign(input,'work2.in');reset(input);
assign(output,'work2.out');rewrite(output);
readln(st);
l1:=length(st);
for i:=0 to 251 do
x[i]:=0;
for i:=l1 downto 1 do
x[l1-i]:=ord(st[i])-ord('0');
readln(st);
l2:=length(st);
for i:=0 to 251 do y[i]:=0;
for i:=l2 downto 1 do
y[l2-i]:=ord(st[i])-ord('0');
if l1 for i:=0 to l1 do
begin
x[i]:=x[i]+y[i];
x[i+1]:=x[i+1]+x[i] div 10;
x[i]:=x[i] mod 10;
end;
j:=251;
while x[j]=0 do
j:=j-1;
for i:=j downto 0 do
write(x[i]);
close(input);
close(output);
end.
3.
program gds;
var
a,b,c:array[1..250] of integer;
n,n1,n2:string;
lena,lenb,lenc,i:integer;
begin
assign(input,'work3.in');reset(input);
assign(output,'work3.out');rewrite(output);
readln(n1);
readln(n2);
if(length(n1) begin
n:=n1; n1:=n2; n2:=n;
write('-');
end;
lena:=length(n1); lenb:=length(n2);
for i:=1 to lena do a[lena-i+1]:=ord(n1[i])-ord('0');
for i:=1 to lenb do b[lenb-i+1]:=ord(n2[i])-ord('0');
i:=1;
while i<=lena do
begin
if a[i] begin
a[i]:=a[i]+10;
a[i+1]:=a[i+1]-1;
end;
c[i]:=a[i]-b[i];
i:=i+1;
end;
lenc:=i;
while(c[lenc]=0) and (lenc>1) do dec(lenc);
for i:=lenc downto 1 do write(c[i]);
close(input);
close(output);
end.
4.program gds;
var
i,j,la,lb,len:integer;
s1,s2:string;
m:longint;
a,b,c:array[1..250] of integer;
begin
assign(input,'work4.in');reset(input);
assign(output,'work4.out');rewrite(output);
readln(s1);
la:=length(s1);
readln(s2);
lb:=length(s2);
for i:=1 to la do
a[i]:=ord(s1[la-i+1])-48;
for i:=1 to lb do
b[i]:=ord(s2[lb-i+1])-48;
for i:=1 to la do
for j:=1 to lb do
c[i+j-1]:=c[i+j-1]+a[i]*b[j];
len:=la+lb;
for i:=1 to len do
begin
c[i+1]:=c[i+1]+c[i] div 10;
c[i]:=c[i] mod 10;
end;
while c[len]=0 do dec(len);
m:=c[len];
while m>0 do
begin
c[len]:=m mod 10;
m:=m div 10;
inc(len);
end;
for i:=len-1 downto 1 do
write(c[i]);
close(input);
close(output);
end.
5.
program gds;
type aa=array[1..17,1..17] of integer;
bb=array[1..100] of integer;
var a:aa;
i,j,n,s,p,q,k:integer;
procedure pan(x,n:integer);
begin
if n<10 then
write(x)
else
case x of
1,2,3,4,5,6,7,8,9,0:write(x);
10:write('A');
11:write('B');
12:write('C');
13:write('D');
14:write('E');
15:write('F');
end;
end;
procedure fen(var k:integer;s,n:integer);
var b:bb;
l,x:integer;
begin
k:=0;
repeat
inc(k);
b[k]:=s mod n;
s:=s div n;
until s mod n=0;
for l:=k downto 1 do
begin
x:=b[l];
pan(x,n);
end;
end;
begin
assign(input,'work5.in');reset(input);
assign(output,'work5.out');rewrite(output);
read(n);
for i:=2 to n+1 do
a[i,1]:=i-2;
for i:=2 to n+1 do
a[1,i]:=i-2;
for i:=2 to n+1 do
for j:=2 to n+1 do
a[i,j]:=(i-2)*(j-2);
write('*');
for i:=2 to n+1 do
begin
s:=a[i,1];
write(' ');
fen(k,s,n);
end;
writeln;
p:=2;
q:=1;
repeat
s:=a[q,p];
fen(k,s,n);
if q<>p then
if k=1 then
write(' ')
else
write(' ');
if q=p then
begin
q:=1;
inc(p);
writeln;
end
else
begin
inc(q);
if q=n+1 then
begin
s:=a[q,p];
fen(k,s,n);
end;
end;
until q=n+1;
close(input);
close(output);
end.
望采纳。

问题A程序：

var
n:integer;
a:array[1..9,1..9] of byte;
f:text;
i,j,k,m:integer;
begin
assign(f,'数独.in');
reset(f);
readln(f,n);
for k:=1 to n do begin
m:=0;
while not seekeof(f) do begin
for i:=1 to 9 do begin
for j:=1 to 9 do read(f,a[i,j]);
readln(f);
end;
end;

for i:=1 to 9 do if a[i,1]+a[i,2]+a[i,3]+a[i,4]+a[i,5]+a[i,6]+a[i,7]+a[i,8]+a[i,9]<>45 then inc(m);
for j:=1 to 9 do if a[1,j]+a[2,j]+a[3,j]+a[4,j]+a[5,j]+a[6,j]+a[7,j]+a[8,j]+a[9,j]<>45 then inc(m);
for i:=1 to 3 do for j:=1 to 3 do
if a[(i-1)*3+1,(j-1)*3+1]+a[(i-1)*3+1,(j-1)*3+2]+a[(i-1)*3+1,(j-1)*3+3]+
a[(i-1)*3+2,(j-1)*3+1]+a[(i-1)*3+2,(j-1)*3+2]+a[(i-1)*3+2,(j-1)*3+3]+
a[(i-1)*3+3,(j-1)*3+1]+a[(i-1)*3+3,(j-1)*3+2]+a[(i-1)*3+3,(j-1)*3+3]<>45
then inc(m);
if m=0 then writeln(k:5,' right') else writeln(k:5,' wrong');
end;
close(f);
end.