DFS modification works very good!:

b[i] = 0 when this necrologue was not visited.
     = 1 when necrologue is beeing processed
     = 2 when necrologue was processed.

TextLen[i] = Length of i-th necrologue.
Text[i][j] - j-th letter of i-th necrologue.

1. b[i] = 0, TextLen[i] = 0; for all necrologues i.
2. We call DFS_Visit(1);

1. DFS_Visit(v)   v - necrologue
2. b[v] = 1        We are processing this necro
3. TextLen[v] = 0  Just in case
4. Sequently for all character s = 1, 2, 3, ...
  5. If this is character of necro. increase TextLen[v] by 1
  6. If this is link to other necro (say u) then do next
  7. If b[u] = 1   then we gone to a loop write answer and exit
  8. If b[u] = 2   then we already processed necro u and we know
TextLen[u], so we can increase TextLen[v] by TextLen[u].
  9. If b[u] = 0   then we call DFS_Visit(u) and if it returned
increase TextLen[v] by TextLen[u].
10. b[v] = 0;

With each increase of TextLen we must check wether it becomes greater
than 1 000 000 if so Stop execution.

i just do the dfs and then i write the answer with the recursion...
but always TLE

var
n:array[1..9,0..1001]of char;
b:array[1..9]of byte;
textlen:array[1..9]of longint;
wypisane,ile:longint;

procedure wczytaj;
var
   i,k:longint;
   zn:char;
   zb:text;
begin
{assign(zb,'1253.in');
reset(zb);}
readln({zb,}ile);
 for i:=1 to ile do
  begin
  k:=0;
  read({zb,}zn);
   while zn<>'#'do
    begin
    inc(k);
    n[i,k]:=zn;
    read({zb,}zn)
    end;
  inc(k);
  n[i,k]:='#';
  readln{(zb)}
  end;
{close(zb)}
end;

procedure dzialaj(x:longint);
 var
  i,kt:longint;
  zn:char;
begin
 i:=1;
 zn:=n[x,i];
  while zn<>'#'do
   begin
    if zn='*' then
      begin
       kt:=ord(n[x,i+1])-48;
       i:=i+2;
       dzialaj(kt)
      end
    else
     begin
     write(zn);
     inc(i)
     end;
   zn:=n[x,i];
   end;
end;

procedure koniec;
begin
writeln('#');
halt
end;

procedure dfsvisit(v:byte);
var zn:char;
     i:integer;
begin
b[v]:=1;
i:=1;
textlen[v]:=0;
zn:=n[v,i];
 while zn<>'#'do
  begin
   if ((ord(zn)-48)>0)and((ord(zn)-48)<10)and(n[v,i-1]='*')then
    begin
     if b[ord(zn)-48]=1 then
      begin
       writeln('#');
       halt
      end
     else if b[ord(zn)-48]=2 then
       begin
       textlen[v]:=textlen[v]+textlen[ord(zn)-48];
       if textlen[v]>1000000 then koniec
       end
     else if b[ord(zn)-48]=0 then
      begin
      dfsvisit(ord(zn)-48);
      textlen[v]:=textlen[v]+textlen[ord(zn)-48];
      if textlen[v]>1000000 then koniec
      end;
     inc(i)
    end
   else if zn='*'then inc(i)
   else
     begin
     inc(textlen[v]);
     if textlen[v]>1000000 then koniec;
     inc(i)
     end;
   zn:=n[v,i]
  end;
b[v]:=2;
end;

procedure dfs;
begin
 fillchar(b,sizeof(b),0);
 fillchar(textlen,sizeof(textlen),0);
 dfsvisit(1)
end;

begin
wczytaj;
dfs;
dzialaj(1);
end.

It's the "return symbol".
In C/C++ "return symbol" is '\n', it is just 1 byte.
But in Pascal "return symbol" is #13#10, it is 2 byte.

My program made the same mistake as your :-)
Good Luck!

> It's the "return symbol".
> In C/C++ "return symbol" is '\n', it is just 1 byte.
> But in Pascal "return symbol" is #13#10, it is 2 byte.
>
> My program made the same mistake as your :-)
> Good Luck!