Here is my program. It gets wrong answer
const    max1   = 500;
         max2   = 80;

         fi     = 'disk.inp';

type     xau    = string[max2];

var      a        :array[0..max1] of xau;
         n        :longint;

         f        :text;

procedure input;
var   i         :longint;
      st        :string;
begin
{  assign(f, fi); reset(f);}
  readln({f,} n);
  for i := 1 to n do
  begin   readln({f,} st);
          while st[1] = ' ' do delete(st,1,1);
          while st[ length(st) ] = ' ' do delete(st, length(st), 1);
          a[i] := st;
  end;
{  close(f);}
end;


function ma( t :char) :byte;
begin
  if t = '\' then ma := 2
             else ma := ord(t);
end;


function be(x,y :xau) :boolean;
var     i             :longint;
begin
  be := true;

  x := x + char(1);
  y := y + char(1);
  for i := 1 to length(x) do
    if x[i] <> y[i] then break;
  if ma(x[i]) < ma(y[i]) then exit;

  be := false;
end;


procedure doi(i,j :longint);
var    x  :xau;
begin
  x := a[i]; a[i] := a[j]; a[j] := x;
end;


procedure sort(l,r :longint);
var     i,j        :longint;
        x          :xau;
begin
  i := l; j := r; x := a[ l + random(r-l+1) ];

  repeat
    while be( a[i] , x ) do inc(i);
    while be( x , a[j] ) do dec(j);

    if i <= j then
    begin
      doi(i,j);
      inc(i); dec(j);
    end
  until i > j;

  if l < j then sort(l,j);
  if i < r then sort(i,r);
end;


procedure tim_cho_khac(i :longint; var k,bac :longint);
var      j               :longint;
begin
  a[i-1] := a[i-1] + char(1);
  bac := 0;k := 1;

  for  j := 1 to length( a[i-1] ) do
  begin
    if a[i][j] = '\' then
    begin  inc(bac);
           k := j+1;
    end;

    if a[i-1][j] <> a[i][j] then exit;
  end;
end;


procedure viet(x :xau; bac :longint) ;
var   i   :longint;
begin
  for i := 1 to bac do write(' ');
  writeln(x);
end;


procedure ghi(s :xau; k,bac :longint);
var    t,j            :longint;
       x              :xau;
begin
  s := s + '\';
  t := length(s);
  j := k;  x := '';

  while j <= t do
  begin
    if s[j] = '\' then
    begin  viet( x, bac );
           inc( bac );
           x := '';
    end
    else   x := x + s[j];

    inc(j);
  end;
end;


procedure out;
var    i,k,bac  :longint;
begin
  a[0] := '';
  for i := 1 to n do
  begin
    tim_cho_khac(i,k,bac);
    ghi(a[i],k,bac);
  end;
end;


begin
  input;
  sort(1,n);
  out;
end.

 this test you're wrong  ( I think so ! )
3
a\b
a\b\c
b\c\d

My answer is :
a
 b
   c
     d
your answer differs from me .

for test
3
a\b
a\b\c
b\c\d
wright answer is
a
 b
  c
b
 c
  d

Andrey Popyk.

>  this test you're wrong  ( I think so ! )
> 3
> a\b
> a\b\c
> b\c\d
>
> My answer is :
> a
>  b
>    c
>      d
> your answer differs from me .
>
>