[crawler]

хм а это идея но боюсь не поможет

Поможет... у тебя проблема в том что код "грязный", поэтому и ошобку найти не можешь.

procedure search(n:link;j:integer);
var i,buf :integer;
    ik:boolean;
    k,neo:link;
    d :array[1..10] of integer;
begin

    d[j]:=n^.data;
    writeln(' d[', j, ']=', d[j]); {добавь эту строку - поймешь как заполняется массив} 
    if n^.right<>nil then
    begin
        j:=j+1;
        search(n^.right,j);
    end;
    
    if n^.left<>nil then
    begin
        j:=j+1;
        search(n^.left,j);
    end;
    
    if (n^.left=nil) and (n^.right=nil) then
    begin
        for j:=1 to 10 do begin
            write(d[j],' ');end;
        repeat
            ik:=true ;
            for j:=1 to 9 do
                if d[j]>d[j+1] then
            begin
                buf:=d[j];
                d[j]:=d[j+1];
                d[J+1]:=buf;
                ik:=false;
            end; { вообще проверяет только соседей } 
       until ik;
        end;
        for j:=1 to 9 do begin
            if d[j]=d[j+1] then begin
                writeln ('est odinakovie elementi =',d[j]);
        end;
    end;
end; {search}