I think I've passed all the tests ther user TEST sent here,
but I always get Crash(access violation).
Could you tell me why?


program p1005;
type
  number=record
    n:array[1..300]of integer;
    nk:integer;
  end;
var
  a,s,t:string;
  f:array[1..200]of number;
  ansk,i,j,st,p,long:integer;
  final,ans:number;
  d1:boolean;

  function combine(x,y:string):string;
  var
    i:integer;
  begin
    for i:=length(x) downto 1 do
      if copy(x,length(x)-i+1,i)=copy(y,1,i) then
      begin
        x:=x+copy(y,i+1,length(y)-i);
        exit(x);
      end;
    exit(x+y);
  end;


  function next(ts:string):string;
  var
    i:integer;
  begin
    i:=length(ts);
    ts[i]:=succ(ts[i]);
    while (ts[i]=':')and(i>0) do
    begin
      ts[i]:='0';
      ts[i-1]:=succ(ts[i-1]);
      dec(i);
    end;
    if i=0 then begin ts:='1'+ts;ts:=copy(ts,1,length(ts)-1);end;
    exit(ts);

  end;

  function check(st:integer;a:string):boolean;
  var
    ts:string;
    watch,k,now:integer;
    back:boolean;


  begin
    back:=false;
    if st<>1 then
    begin
      ts:=copy(s,1,st-1);

      k:=length(ts);
      if (ts[1]='0')and(abs(length(ts)-length(a))<1) then exit(false);
      ts:=next(ts);
      if copy(a,1+length(a)-k,k)<>copy(ts,length(ts)-k+1,k) then exit(false);
    end;
    now:=st;
    ts:=a;
    while now+length(ts)-1-ord(back)<=length(s) do
    begin
      if copy(s,now,length(ts))<>ts then exit(false);
      now:=now+length(ts);
      ts:=next(ts);
    end;

    if now>length(s) then exit(true);
    if copy(s,now,length(s)-now+1)<>copy(ts,1,length(s)-now+1) then
    exit(false);
    exit(true);
  end;

  function plus(a,b:number):number;
  var
    i,j,t:integer;
    c:number;
  begin
    if a.nk>b.nk then j:=a.nk else j:=b.nk;
    t:=0;fillchar(c,sizeof(c),0);
    for i:=1 to j do
    begin
      c.n[i+1]:=(a.n[i]+b.n[i]+c.n[i])div 10;
      c.n[i]:=(c.n[i]+a.n[i]+b.n[i])mod 10;
    end;
    if c.n[j+1]<>0 then inc(j);
    c.nk:=j;
    exit(c);
  end;

  procedure makef;
  var

    temp:number;
    i,j:integer;
  begin
    f[1].nk:=1;
    f[1].n[1]:=9;

    for i:=2 to length(a)-1 do
    begin
      fillchar(temp,sizeof(temp),0);
      j:=9*i;
      temp.n[i]:=j;j:=i;
      while temp.n[j]>10 do
      begin
        temp.n[j+1]:=temp.n[j] div 10;
        temp.n[j]:=temp.n[j] mod 10;
        inc(j);
      end;
      temp.nk:=j;
      f[i]:=plus(f[i-1],temp);
    end;
  end;

  procedure makeans;
  var
    k,l,i,j:integer;
    temp:number;
  begin
    fillchar(ans,sizeof(ans),0);
    ans:=plus(ans,f[length(a)-1]);
    l:=length(a);


    {i:=ord(a[1])-49;
    if i<>0 then
    begin
      fillchar(temp,sizeof(temp),0);
      temp.n[l]:=i*l;i:=l;
      while temp.n[i]>=10 do
      begin
        temp.n[i+1]:=temp.n[i] div 10;
        temp.n[i]:=temp.n[i] mod 10;
        inc(i);
      end;
      temp.nk:=i;
      ans:=plus(ans,temp);
    end;}

    for k:=1 to l do
    begin
      i:=ord(a[k])-48;if k=1 then dec(i);if k=l then inc(i);
      fillchar(temp,sizeof(temp),0);
      temp.n[l-k+1]:=i*l;i:=l-k+1;
      while temp.n[i]>10 do
      begin
        temp.n[i+1]:=temp.n[i] div 10;
        temp.n[i]:=temp.n[i] mod 10;
        inc(i);
      end;
      temp.nk:=i;
      ans:=plus(ans,temp);
    end;
  end;

  function minus(a,b:number):number;
  var
    i,j:Integer;
    c:number;
  begin
    fillchar(c,sizeof(c),0);
    for i:=1 to a.nk do
    begin
      c.n[i]:=c.n[i]+a.n[i]-b.n[i];
      if c.n[i]<0 then
      begin
        inc(c.n[i],10);
        dec(c.n[i+1]);
      end;
    end;
    if a.n[a.nk]=0 then c.nk:=a.nk-1 else c.nk:=a.nk;
    exit(c);
  end;


  procedure print;
  var
    i,j:integer;
    temp:number;
  begin
    i:=0;
    while p>0 do
    begin
      inc(i);
      temp.n[i]:=p mod 10;
      p:=p div 10;
    end;
    temp.nk:=i;
    ans:=minus(ans,temp);
    if ans.nk<final.nk then final:=ans;
    if ans.nk=final.nk then
    begin
      i:=ans.nk;
      while ans.n[i]=final.n[i] do dec(i);
      if ans.n[i]<final.n[i] then final:=ans;
    end;
  end;









begin

  final.nk:=1000;
  readln(s);

  for long:=1 to length(s) do
    for st:=1 to length(s)-long+1 do
    begin
      a:=(copy(s,st,long));
      if (check(st,a))and(a[1]<>'0') then
      begin
        makef;
        makeans;
        p:=st+long-2;
        print;
      end;
      if st<>length(s)-long+1 then continue;

      t:=next(copy(s,1,st-1));
      t:=copy(t,length(t)-st+2,st-1);
      a:=combine(a,t);
      if (check(st,a))and(a[1]<>'0') then
      begin
        makef;
        makeans;
        p:=st+length(a)-2;
        print;
      end;

  end;

  a:='1'+s;
  makef;
  makeans;
  p:=length(s)-1;
  print;

  for i:=final.nk downto 1 do write(final.n[i]);
  writeln;



end.