My solution:
***
program lam;
var st,s1,s2,ins: string; e1,e2,k,n2,n1,e,z,q,i: integer;
begin
readln(st);
z:=0;
if st[1]='0' then begin
q:=1;
for i:=2 to 5 do begin
if st[i]='0' then inc(q);
if st[i]<>'0' then break;
end;
end;
val(st,e,k);
n1:=e+1; n2:=e-1;
str(n1,s1); str(n2,s2);
if q=1 then begin
ins:='0'; insert(ins,s1,1);
end;
if q=2 then begin
ins:='00'; insert(ins,s1,1);
end;
if q=3 then begin
ins:='000'; insert(ins,s1,1);
end;
if q=4 then begin
ins:='0000'; insert(ins,s1,1);
end;
if q=5 then begin
ins:='00000'; insert(ins,s1,1);
end;
if q=1 then begin
ins:='0'; insert(ins,s2,1);
end;
if q=2 then begin
ins:='00'; insert(ins,s2,1);
end;
if q=3 then begin
ins:='000'; insert(ins,s2,1);
end;
if q=4 then begin
ins:='0000'; insert(ins,s2,1);
end;
if q=5 then begin
ins:='00000'; insert(ins,s2,1);
end;
val(copy(s1,1,3),e1,k);
val(copy(s1,4,3),e2,k);
if (e1 mod 10)+((e1 mod 100) div 10)+(e1 div 100)=(e2 mod 10)+((e2 mod 100) div 10)+(e2 div 100) then
z:=1;
val(copy(s2,1,3),e1,k);
val(copy(s2,4,3),e2,k);
if (e1 mod 10)+((e1 mod 100) div 10)+(e1 div 100)=(e2 mod 10)+((e2 mod 100) div 10)+(e2 div 100) then
z:=1;
if z=1 then writeln('YES') else writeln('NO');
end.
***
очень большое и глупое решение, гораздо проще вот так:
function prov(n:longint):integer;
var a1,a2,a3,b1,b2,b3:integer;
begin
a1:=n div 100000;
a2:=n div 10000 mod 10;
a3:=n div 1000 mod 10;
b1:=n div 100 mod 10;
b2:=n div 10 mod 10;
b3:=n mod 10;
if b1+b2+b3=a1+a2+a3 then prov:=1 else prov:=2;
end;
var n,n1,n2:longint;
begin
read(n);
n1:=n+1;
n2:=n-1;
if (prov(n1)=1)or(prov(n2)=1) then writeln('Yes') else writeln('No');
end.
sorry for russian.
P.S. Time 0.031 Memory 118