At last I got AC!My Solution here:
program lucky;
const
 maxn=200;
type
 arraytype=array[0..maxn]of integer;
var
 p:array[0..1,0..500]of arraytype;
 b:arraytype;
 len:array[0..1,0..500]of integer;
 n,m,i:integer;
procedure init;
var
 i,j:integer;
begin
 readln(n,m);
 if odd(m) then
  begin
   writeln('0');
   halt;
  end;
 m:=m div 2;
 fillchar(p,sizeof(p),0);
 for i:=0 to m do
  for j:=0 to 1 do
   len[j,i]:=1;
 p[0,0,1]:=1;
end;
procedure add(x,y:integer);
var
 l,i:integer;
begin
 if len[1,x]>len[0,y] then
  l:=len[1,x]
 else
  l:=len[0,y];
 for i:=1 to l do
  begin
   p[1,x][i]:=p[1,x][i]+p[0,y][i];
   p[1,x][i+1]:=p[1,x][i+1]+p[1,x][i] div 10;
   p[1,x][i]:=p[1,x][i] mod 10;
  end;
 while p[1,x][l+1]<>0 do
  begin
   inc(l);
   p[1,x][l+1]:=p[1,x][l] div 10;
   p[1,x][l]:=p[1,x][l] mod 10;
  end;
 len[1,x]:=l;
end;
procedure solve;
var
 i,j,k,jj:integer;
begin
 for i:=1 to n do
  begin
   for j:=0 to m do
    for k:=0 to 9 do
     if (j+k<=m) and (j+k<>0) then
       add(j+k,j);
   p[0]:=p[1];
   p[0,0,1]:=1;
   len[0]:=len[1];
   len[0,1]:=1;
   fillchar(p[1],sizeof(p[1]),0);
  end;
end;
procedure square;
var
 i,j:integer;
begin
 fillchar(b,sizeof(b),0);
 for i:=1 to len[0,m] do
  for j:=1 to len[0,m] do
   begin
    b[i+j-1]:=b[i+j-1]+p[0,m,i]*p[0,m,j];
    b[i+j]:=b[i+j]+b[i+j-1] div 10;
    b[i+j-1]:=b[i+j-1] mod 10;
   end;
 len[0,m]:=2*len[0,m]-1;
 while b[len[0,m]+1]<>0 do
  begin
   inc(len[0,m]);
   b[len[0,m]+1]:=b[len[0,m]] div 10;
   b[len[0,m]]:=b[len[0,m]] mod 10;
  end;
 for i:=len[0,m] downto 1 do
  write(b[i]);
 writeln;
end;
begin
 init;
 solve;
 square;
end.