Dateien und Ordner auflisten als XML

[SaFu]

Abend,

Und zwar habe ich folgendes Problem, ich möchte gerne Ordner und die darin liegenden Dateien auflisten lassen und zwar in einer XML Strucktur.

Wenn ich z.b. so eine Ordnerstrucktur habe

Delphi-Quellcode:

Ordner1
 -MeineDatei1
 -MeineDatei2
 -MeineDatei3
 
 -Ordner2
  -DeineDatei1
  -DeineDatei2
  -DeineDatei3
  -DeineDatei4
 
 -Ordner3
  -SeineDatei1
  -SeineDatei2

Dann muss ich jetzt per FindFirst und FindNext alle Ordner und Dateien ermitteln.

Aber wie bekomme ich als ergebnis diese Strucktur

Im Hauptverzeichnis Ordner1

Delphi-Quellcode:

<files> // dieses File nur im obersten Ordner anstatt des Ordnernamens
 <FileName>MeineDatei1</fileName>
 <FileName>MeineDatei2</fileName>
 <FileName>MeineDatei3</fileName>
</files>

<Ordner2> // hier der Ordnername weil es ein Unterverzeichnis ist
 <FileName>Ordner2/MeineDatei1</fileName>
 <FileName>Ordner2/MeineDatei2</fileName>
 <FileName>Ordner2/MeineDatei3</fileName>
 <FileName>Ordner2/MeineDatei4</fileName>
</Ordner2> 

<Ordner3> // hier der Ordnername weil es ein Unterverzeichnis ist
 <FileName>Ordner3/MeineDatei1</fileName>
 <FileName>Ordner3/MeineDatei2</fileName>
</Ordner3>

usw.

So bekomme ich alle Dateien aufgelistet aber nur ohne die Unterverzeichnisse

Delphi-Quellcode:

procedure FileList(const APath, AExt: string; ARecurse: Boolean; AList: TStrings);
var
  F    : TSearchRec;
  Path : string;
begin
  Path := IncludeTrailingPathDelimiter(APath); // nur für Delphi 4 und höher!
  if (ARecurse) and (FindFirst(Path + '*.*', faAnyFile, F) = 0) then
  try
    repeat
      if (F.Name <> '.') and (F.Name <> '..') and ((F.Attr and faDirectory) = faDirectory) then
        FileList(Path + F.Name, AExt, ARecurse, AList);
    until
     FindNext(F) <> 0;
  finally
    FindClose(F);
  end;
  if FindFirst(Path + AExt, faAnyFile, F) = 0 then
  try
    repeat
      if (F.Name <> '.') and (F.Name <> '..') and ((F.Attr and faDirectory) <> faDirectory) then
        AList.Add(Path + F.Name);
    until
     FindNext(F) <> 0;
  finally
    FindClose(F);
  end;
end;

procedure TfrmTemplateerstellen.btn1Click(Sender: TObject);
var i: integer;
s :TStringList;
begin
  s:= TStringList.Create();
  try
    Mmo1.Lines.BeginUpdate;
    try
      Mmo1.Lines.Clear;
      FileList(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)) + edtDirectoryName.Text) ,'*.*',True,s);
      for i := 0 to Pred(s.Count) do
        Mmo1.Lines.Add('<filename>'+ExtractFileName(s[i])+'</filename>');
    finally
      Mmo1.Lines.EndUpdate;
    end;
  finally
    s.Free;
  end;
end;

Danke im voraus