INPUT:
a\b
d\a
cc\e
e\d

OTHERWISE,does it have any special situations ?

The output should be:

a
 b
cc
 e
d
 a
e
 d

I don't think so.
But you should take care not to repeat entries, like  in
this situation:

input:
a/b
a

output:
a
 b

and NOT:
a
 b
a

type
  Ttree=^atree;
  atree=record
    name:string;
    son:Ttree;
    same:Ttree;
  end;
var
  tree:Ttree;
  i,j,k,n:integer;
  p:Ttree;
  s:string;
procedure create(s:string;var p:Ttree);
var
  t,q:ttree;
  ss:string;
begin
  if s='' then exit;
  new(q);q^.name:='';
  q^.same:=nil;
  q^.son:=nil;
  ss:=copy(s,1,pos('\',s)-1);
  delete(s,1,pos('\',s));
  if p=nil then begin
    q^.name:=ss;
    create(s,q^.son);
    p:=q;
    p^.same:=p;
  end else begin
    t:=p;
    while (p^.name<ss)and(p^.same<>t)and(p^.same^.name<=ss)
do
      p:=p^.same;
    if p^.name=ss then create(s,p^.son) else begin
      q^.name:=ss;
      create(s,q^.son);
      q^.same:=p^.same;
      p^.same:=q;
    end;
  end;
  while p^.same^.name>p^.name do
    p:=p^.same;
  while p^.same^.name<p^.name do
    p:=p^.same;
end;
procedure print(i:integer;q:Ttree);
var
  t:ttree;
begin
  t:=q;
  repeat
    writeln(' ':i+1,q^.name);
    if q^.son<>nil then print(i+1,q^.son);
    q:=q^.same;
  until q=t;
end;

begin
  tree:=nil;
  readln(n);
  for i:=1 to n do begin
    readln(s);
    create(s+'\',tree);
  end;
  print(0,tree);
end.

Program disktree;
  const
    max=500;
  var
    a:array[1..max] of string[100];
    n:integer;

procedure init;
  var
    i,j:integer;
  begin
    readln(n);
    for i:=1 to n do
      begin
        readln(a[i]);
        for j:=1 to length(a[i]) do
          if a[i,j]='\' then
            a[i,j]:=#1;
      end;
  end;

procedure mendheap(i,now:integer);
  var
    t:integer;
    st:string[80];
  begin
    while i shl 1<=now do
      begin
        if i shl 1=now then
          t:=now
        else
          if a[i shl 1]>a[i shl 1+1] then
            t:=i shl 1
          else
            t:=i shl 1+1;
        if a[i]<a[t] then
          begin
            st:=a[i]; a[i]:=a[t]; a[t]:=st;
            i:=t;
          end
        else
          i:=now;
      end;
  end;

procedure dothing;
  var
    i:integer;
    st:string[80];
  begin
    for i:=n shr 1 downto 1 do
      mendheap(i,n);
    for i:=n-1 downto 2 do
      begin
        st:=a[1]; a[1]:=a[i+1]; a[i+1]:=st;
        mendheap(1,i);
      end;
    st:=a[1]; a[1]:=a[2]; a[2]:=st;
  end;

procedure print;
  var
    i,j,t,t1:integer;
    s,s1,s2,st:string;
  begin
    s:=#0#0;
    for i:=1 to n do
      begin
        st:=a[i];
        if s=copy(st,1,length(s)) then
          begin
            t:=1;
            for j:=1 to length(s) do
              if s[j]=#1 then
                inc(t);
          end
        else
          begin
            j:=1; t:=0;
            while st[j]=s[j] do
              begin
                if st[j]=#1 then
                  inc(t);
                inc(j);
              end;
          end;
        j:=1; t1:=t;
        while t1>0 do
          begin
            if st[j]=#1 then
              dec(t1);
            inc(j);
          end;
        s:=st; st:=st+#1;
        delete(st,1,j-1);
        while st>'' do
          begin
            if t>0 then
              write(' ':t);
            j:=pos(#1,st);
            writeln(copy(st,1,j-1));
            inc(t);
            delete(st,1,j);
          end;
      end;
  end;

  Begin
    init;
    dothing;
    print;
  End.