anyone comment?
here is my 30th sumbit for 3rd algorithm

Type
  Sentence            =array[1..45] of String[9];
  Folder              =Record
    Name              :sentence;
    L                 :Byte;
  End;
Var
  A                   :Array[0..2000] of Folder;
  A0,p0               :Integer;

Function Big(var xx,yy:sentence; xxl,yyl:integer):boolean;
Var
  min,i               :integer;
begin
  min:=xxl; if yyl<min then min:=yyl;
  i:=0;
  repeat
    inc(i);
    if xx[i]<>yy[i] then
    begin
      big:=(xx[i]>yy[i]);
      exit;
    end;
  until i=min;
  big:=(xxl>=yyl);
end;

{<<<<<<<<<<< Initial >>>>>>>>>>>>}
Procedure Initial;
Var
  N,I,K               :Integer;
  S                   :String;
  N2                  :String[10];
  P                   :Sentence;
Begin
  ReadLn(N);
  A0:=0;
  For I := 1 To N Do
  Begin
    ReadLn(S); S:=S+'\';
    P0:=0;
    Repeat
      K:=Pos('\',S);
      N2:=Copy(S,1,K-1);
      while Length(N2)<8 do
        N2:=N2+' ';
      inc(p0);
      p[p0]:=n2;
      Inc(A0);
      A[A0].Name:=P;
      A[A0].L   :=P0;
      Delete(S,1,k);
    Until Length(S)=0;
  End;
End;

{<<<<<<<<<<<<< Part >>>>>>>>>>>>>}
Function Part(First,Last:Integer):Integer;
Var
  I,J,XL              :Integer;
  X                   :sentence;
Begin
  I:=First-1; J:=Last+1;
  X:=A[First].Name; xl:=a[first].L;
  Repeat
    Repeat inc(I);
    Until big(A[I].Name,X,a[i].l,xl);
    Repeat Dec(J);
    Until big(x,A[J].Name,xl,a[j].l);
    If I<J then Begin
      A[0]:=A[i]; A[I]:=A[J]; A[J]:=A[0]; End
    Else Begin
      Part:=j; Exit; End;
  Until False;
End;

{<<<<<<<<<<<<< Qsort >>>>>>>>>>>>}
Procedure Qsort(First,Last:Integer);
Var
  W                   :Integer;
Begin
  If First<Last Then
  Begin
    W:=Part(First,Last);
    Qsort(First,W);
    Qsort(W+1,Last);
  End;
End;

{<<<<<<<<<< WriteData >>>>>>>>>>>}
Procedure Writedata;
Var
  I,J                 :Integer;
Begin
  a[0]:=a[1]; a[0].l:=a[1].l;
  WriteLn(a[1].name[1]);
  For I:=2 to A0 do
    If not (big(a[i].name,a[0].name,a[i].l,a[0].l) and
            big(a[0].name,a[i].name,a[0].l,a[I].l)) then
    Begin
      For J:=1 to A[I].L-1 do
        Write(' ');
      WriteLn(a[I].name[A[I].L]);
      A[0]:=A[I];
    End;
End;

{<<<<<<<<<<<<< Main >>>>>>>>>>>>>}
Begin
  Initial;
  Qsort(1,A0);
  WriteData;
End.