This is my code, help me with some wrong tests , please ^^
Program Tree2;
Uses    Math;//,crt;
Const   Finp    ='';//
        Fout    ='';
        Maxn    =20001;
Type    Pt      =^rc;
                rc=Record
                 v:Longint;
                 Next:Pt;
                 End;
Var     fi,fo   :Text;
        n,k,Low,S,T:Longint;
        List    :Array[1..Maxn] of Pt;
        A,C,tr,v1,v2,Q,B,F:Array[1..Maxn] of Longint;
        Free    :Array[1..Maxn] of Boolean;
Procedure       OpenFile;
Begin
        Assign(fi,finp); Reset(fi);
        Assign(fo,fout); Rewrite(fo);
End;
Procedure       CloseFile;
Begin
        Close(fi); Close(fo);
End;
Procedure       Push(v:Longint; Var Next:pt);
Var     p:pt;
Begin
        New(p);
        p^.Next:=Next;
        p^.v:=v;
        Next:=p;
End;
Procedure       Readinp;
Var     u,v:Longint;
Begin
        Readln(fi,n,k);
        If n=1 Then
        Begin
                For k:=1 to k do
                Begin
                        Read(fi,u,v);
                If v=0 Then WRiteln(fo,1)
                else Writeln(fo,0);
                End;
                CloseFile;
                Halt;
        End;
        For n:=1 to n do List[n]:=Nil;
        For n:=2 to n do
        Begin
                Readln(fi,u,v);
                Push(u,List[v]);
                Push(v,List[u]);
        End;
End;
Procedure       Dfs(i,x:Longint);
Var     p:Pt;
        v:Longint;
Begin
        If Low < x Then
        Begin
                Low:=x; S:=i;
        End;
        Free[i]:=False;
        p:=List[i];
        While p<> Nil do
        Begin
                v:=p^.v;
                If Free[v] then
                Begin
                        Tr[v]:=i;
                        Dfs(v,x+1);
                End;
                p:=p^.Next;
        End;
End;
Procedure       Prepare;
Var     i,x:Longint;
Begin
        Fillchar(Free,sizeof(Free),True);
        Dfs(1,0);
        Low:=0; T:=S;
        Fillchar(Free,sizeof(Free),True);
        Fillchar(Tr,sizeof(Tr),0);
        DFS(T,0);
        i:=S; x:=1; C[S]:=1; B[1]:=S;
        While True do
        Begin
                i:=Tr[i];
                Inc(x); C[i]:=x; B[x]:=i;
                If i = T Then Break;
        End;
End;
Procedure       Solve;
Var     i,x,dau,cuoi,w,v:Longint;
        p:pt;
Begin
        Inc(Low);
        For i:=1 to Low do
        Begin
                x:=b[i];
                dau:=0; cuoi:=1; Q[1]:=x;
                While dau <> cuoi do
                Begin
                        Inc(dau); w:=Q[dau];
                        p:=List[w];
                        While p<> Nil do
                        Begin
                                v:=p^.v;
                                If (C[v]=0) Then
                                 if (v1[v]=0) Then
                                 Begin
                                        v1[v]:=x;
                                        v2[v]:=v2[w]+1;
                                        Inc(cuoi); Q[cuoi]:=v;
                                 End;
                                p:=p^.Next;
                        End;
                End;
        End;
End;
Function        Found(k,u,l:Longint):Longint;
Var     dau,cuoi,v,x:Longint;
        p:Pt;
Begin
        dau:=0; cuoi:=1;
        F[u]:=0; Q[1]:=u;
        Tr[u]:=k;
        While dau<> cuoi do
        Begin
                Inc(dau); x:=Q[dau];
                p:=List[x];
                While p<> Nil do
                Begin
                        v:=p^.v;
                        If Tr[v] <> k Then
                        Begin
                                F[v]:=F[x]+1;
                                Tr[v]:=k;
                                Inc(cuoi); Q[cuoi]:=v;
                                If F[v]=l Then Exit(v);
                        End;
                        p:=p^.Next;
                End;
        End;
        Exit(0);
End;
Procedure       Answer;
Var     u,v,x,Ans:Longint;
Begin
        Fillchar(tr,sizeof(Tr),0);
        For k:=1 to k do
        Begin
                Readln(fi,u,v);
                If v >= Low Then
                Begin
                        Writeln(fo,0);
                        Continue;
                End;
                If C[u] <> 0 Then
                Begin
                        If v + C[u] <= Low Then
                        Begin
                                v:=v+ C[u];
                                Writeln(fo,B[v]);
                                Continue;
                        End;
                        If v<C[u] Then
                        Begin
                                v:=C[u]-v;
                                Writeln(fo,B[v]);
                                COntinue;
                        End;
                        Writeln(fo,0);
                        Continue;
                End;
                If v2[u]=v Then
                Begin
                        Writeln(fo,v1[u]);
                        Continue;
                End;
                If V2[u] < v Then
                Begin
                        x:=C[v1[u]];
                        If x > v - V2[u] Then
                        Begin
                                x:=x-(v - v2[u]);
                                Writeln(fo,B[x]);
                                Continue;
                        End;
                        If x + (v- v2[u]) <= Low Then
                        Begin
                                x:=x+(v-v2[u]);
                                Writeln(fo,B[x]);
                                Continue;
                        End;
                        Writeln(fo,0);
                        Continue;
                End;
                x:=Found(-k,u,v);
                Writeln(fo,x);
        End;
End;
Function        Dist(u,l:Longint):Longint;
Var     dau,cuoi,v,x:Longint;
        p:Pt;
Begin
        dau:=0; cuoi:=1;
        F[u]:=0; Q[1]:=u;
        Tr[u]:=k;
        While dau<> cuoi do
        Begin
                Inc(dau); x:=Q[dau];
                p:=List[x];
                While p<> Nil do
                Begin
                        v:=p^.v;
                        If Tr[v] <> k Then
                        Begin
                                F[v]:=F[x]+1;
                                Tr[v]:=k;
                                Inc(cuoi); Q[cuoi]:=v;
                                If v=l Then Exit(F[v]);
                        End;
                        p:=p^.Next;
                End;
        End;
        Exit(0);
End;
Procedure       Test;
Var     u,v,l,x:Integer;
Begin
        Assign(fi,finp); Reset(fi);
        Assign(fo,fout); Reset(fo);
        Readln(fi,n,k);
        For n:=2 to n do Readln(fi,u,v);
        For k:=1 to k do
        Begin
                Readln(fi,u,l);
                Readln(fo,v);
                If v=0 Then
                Begin
                        x:=Found(-k,u,l);
                        If x<>0 Then
                        Begin
                                Writeln('sai');
                                Exit;
                        End;
                        COntinue;
                End;
                x:=Dist(u,v);
                Writeln(x,' ',l);
                If x<>l Then
                begin
                        Writeln('Sai');
                        Exit;
                End;
        End;
End;
Begin
//        Clrscr;
        Openfile;
        Readinp;
        Prepare;
        Solve;
        Answer;
        CloseFile;
//        Test;
End.

give me some tests , please ! up

This test help me
10 1
1 2
2 3
3 4
4 5
1 6
6 7
1 8
8 9
9 10

10 7