这个是宽搜的八数码难题，麻烦看下哪里超界了。。
var i,j,k,m,n,p1,p2,l,o1,o2,o3,o4:integer;
r:array[0..4,0..4] of integer;
openx:array[0..1001,0..4,0..4] of integer;
openy:array[0..1001] of integer;
a,b:array[0..4,0..4] of integer;
function check1:boolean;
var q1,q2:integer;
begin
check1:=true;
for q1:=1 to 3 do
for q2:=1 to 3 do
if r[q1,q2]<>b[q1,q2] then
begin
check1:=false;
exit;
end;
end;
function check2:boolean;
var q3,q4,q5:integer;
t:boolean;
begin
check2:=false;
for q3:=1 to p2 do
for q4:=1 to 3 do
for q5:=1 to 3 do
if r[q4,q5]<>openx[q3,q4,q5] then
begin
check2:=true;
exit;
end;
end;
procedure out;
var q:integer;
begin
write(openy[p1]+1);
halt;
end;
begin
p1:=1;p2:=1;
for i:=1 to 3 do
for j:=1 to 3 do
begin
read(a[i,j]);
openx[1,i,j]:=a[i,j];
end;
for i:=1 to 3 do
for j:=1 to 3 do
read(b[i,j]);
fillchar(openy,sizeof(openy),0);
while p1<=p2 do
begin
for i:=1 to 4 do
begin
for o1:=1 to 3 do
for o2:=1 to 3 do
begin
r[o1,o2]:=openx[p1-1,o1,o2];
end;
for j:=1 to 3 do
for k:=1 to 3 do
begin
if r[j,k]=0 then
case i of
1:if (r[j,k+1]<>0) then begin l:=r[j,k+1];r[j,k]:=r[j,k+1];r[j,k+1]:=l; end;
2:if (r[j+1,k]<>0) then begin l:=r[j+1,k];r[j,k]:=r[j+1,k];r[j+1,k]:=l; end;
3:if (r[j,k-1]<>0) then begin l:=r[j,k-1];r[j,k]:=r[j,k-1];r[j,k-1]:=l; end;
4:if (r[j-1,k]<>0) then begin l:=r[j-1,k];r[j,k]:=r[j-1,k];r[j-1,k]:=l; end;
end;
if check1 then out;
if check2 then
begin
inc(p2);
for o3:=1 to 3 do
for o4:=1 to 3 do
openx[p2,o3,o4]:=r[o3,o4];
openy[p2]:=openy[p1]+1;
end;
end;
inc(p1);
end;
end;
end.

人呢？

八数码水题