Dateiliste mit TIdFTP

[MiKaEr]

ich habe ein kleines problem beim erstellen einer verzeichnisstruktur mit der TIdFTP-Komponente.
folgenden code verwende ich.

Delphi-Quellcode:

var
 AFiles, sl: TStrings;
 i: Integer;
 sFN: string;
begin
 IdFTP1.Host := 'xxx';
 IdFTP1.Username := 'xxx';
 IdFTP1.Password := 'xxx';
 IdFTP1.Connect;

 AFiles := TStringList.Create;
 sl := TStringList.Create;
 try
  IdFTP1.List(AFiles, '/_test/*', True);

  for i := 0 to IdFTP1.DirectoryListing.Count - 1 do
   begin
    sFN := Trim(IdFTP1.DirectoryListing.Items[i].FileName);

    if (sFN <> '.') and (sFN <> '..') and (sFN <> '') then
     sl.Add(sFN);
   end;

  showmessage(sl.Text);
 finally
  IdFTP1.Disconnect;
  AFiles.Free;
  sl.Free;
 end;

im verzeichnis "test" befindet sich
- eine datei namens "1.txt"
- ein verzeichnis namens "2"
- - in diesem verzeichnis eine weitere datei namens "2.txt".


mein resultat (showmessage) sieht aber so aus:

Zitat:

---
/test/1.txt
2.txt
---

eigentlich müsste es aber heißen

Zitat:

---
/test/1.txt
/test/2/2.txt
---

wo ist das problem?

[MiKaEr]

hab es nun folgendermaßen, sehr umständlich hinbekommen:

Delphi-Quellcode:

procedure ListDir(aDir: string);
var
 aItem: TIdFTPListItems;
 i: Integer;
begin
 Form1.IdFTP1.ChangeDir(aDir);
 Form1.IdFTP1.List;
 aItem := Form1.IdFTP1.DirectoryListing;

 for i := aItem.Count - 1 downto 0 do
  begin
   if (aItem.Items[i].FileName = '.') or (aItem.Items[i].FileName = '..') then
    aItem.Delete(i);
  end;

 if aItem.Count = 0 then
  Form1.Memo1.Lines.Add(Form1.IdFTP1.RetrieveCurrentDir + '/')
 else
  begin
   for i := 0 to aItem.Count - 1 do
    begin
     Application.ProcessMessages;

     with aItem.Items[i] do
      begin
       if ItemType = ditDirectory then
        ListDir(aItem.Items[i].FileName)
       else
        Form1.Memo1.Lines.Add(Form1.IdFTP1.RetrieveCurrentDir + '/' + FileName);
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo1.Lines.Clear;
 ListDir('/_test/');
end;

[jaenicke]

Es würde mich wundern, wenn das immer klappen würde, da du nur eine Referenz auf die Verzeichnisliste hast und diese in der Rekursion einen anderen Inhalt bekommt...
Zudem wechselst du immer nur in das Verzeichnis hinein und nicht wieder hinaus.

Ich habe im Moment gerade keine Zeit, aber ich würde das ganze über eine Arbeitsqueue lösen, die immer die noch abzuarbeitenden Verzeichnisse bekommt und diese Liste abarbeitet solange sie nicht leer ist. Dann brauchst du keine Rekursion, hast immer gleich den vollständigen Pfad, ...

[MiKaEr]

das ist leider zu hoch für mich.

wenn jemand eine bessere lösung hat, kann er sie gerne posten. ich werde mir diese dann sehr genau ansehen und lernen.

[MiKaEr]

folgendes habe ich schon einmal. das funktioniert zwar einigermaßen, aber nur, wenn ich "details" auf false setze. verzeichnisse werden dann wohl nicht mehr erkannt.
von rekursiv kann man hier nicht sprechen

Delphi-Quellcode:

procedure listfiles(aDir: string);
var
 i: Integer;
 aItem: TIdFTPListItem;
begin
 Form1.IdFTP1.List(nil, aDir, true);

 for i := 0 to Pred(Form1.IdFTP1.ListResult.Count) do
  begin
   aItem := Form1.IdFTP1.DirectoryListing[i];
   if (aItem.FileName <> '.') and (aItem.FileName <> '..') then
    begin
     if aItem.ItemType = ditDirectory then
      begin
       Form1.Memo1.Lines.Add(aItem.FileName);
       listfiles(aItem.FileName);
      end else
       begin
        Form1.Memo1.Lines.Add(aItem.FileName);
       end;
    end;
  end;
end;

[Luckie]

Warum kann man von rekursiv nicht sprechen? Die Funktion ruft sich doch selber wieder auf. Dass die Rekursion nicht funktioniert, ist was anderes. ;)

aber hatten wir nicht schon mal einen Thread, in dem es um Rekursion mit den Indys ging? Was ist denn da rumgekommen.

[MiKaEr]

da gibt es sogar mehrere threads. ich habe alle durch und keiner ist hilfreich. deswegen habe ich mir ja mittlerweile zwei eigene prozeduren geschrieben (sehr ähnlich) aber auch die funktionieren nicht.

[jaenicke]

Mal ein bisschen sauber aufgearbeitet:

Delphi-Quellcode:

  TForm34 = class(TForm)
  [...]
  private
    FCancelled: Boolean;
  public
  end;

[...]

procedure ListFTPDirectory(const AFTP: TIdFTP; const ADir: string; const ATarget: TStrings; const AIncludeSubDirs: Boolean;
  ACancelled: PBoolean = nil);
{$BOOLEVAL OFF}
var
  FTPItemList: TIdFTPListItems;
  CurrentItem: TIdFTPListItem;
  i: Integer;
  CurrentWorkingDir: string;
  DirectoryQueue: TStringList;
begin
  DirectoryQueue := TStringList.Create;
  try
    DirectoryQueue.Add(ADir);
    while (DirectoryQueue.Count > 0) and (not Assigned(ACancelled) or not ACancelled^) do
    begin
      CurrentWorkingDir := DirectoryQueue[0] + '/';
      DirectoryQueue.Delete(0);
      AFTP.ChangeDir(CurrentWorkingDir);
      AFTP.List;
      FTPItemList := AFTP.DirectoryListing;
      if FTPItemList.Count = 0 then
        ATarget.Add(CurrentWorkingDir)
      else
        for i := 0 to FTPItemList.Count - 1 do
        begin
          Application.ProcessMessages;
          CurrentItem := FTPItemList.Items[i];
          if (CurrentItem.FileName <> '.') and (CurrentItem.FileName <> '..') then
            if CurrentItem.ItemType = ditDirectory then
              if AIncludeSubDirs then
                DirectoryQueue.Insert(0, CurrentWorkingDir + CurrentItem.FileName)
              else
                ATarget.Add(CurrentWorkingDir + CurrentItem.FileName + '/')
            else
              ATarget.Add(CurrentWorkingDir + CurrentItem.FileName);
        end;
    end;
  finally
    DirectoryQueue.Free;
  end;
end;

procedure TForm34.btnStartClick(Sender: TObject);
begin
  FCancelled := False;
  IdFTP1.Connect;
  ListFTPDirectory(IdFTP1, '/html', Memo1.Lines, True, @FCancelled);
end;

procedure TForm34.btnCancelClick(Sender: TObject);
begin
  FCancelled := True;
end;

[MiKaEr]

erst einmal vielen dank für dieses beispiel!

doch leider wird nur ein unterverzeichnis "durchsucht".

wenn der ordner auf dem server z.b.
-----
ordner 1
ordner 2
datei 1
-----

enthält, so wird nur ordner 1, dessen inhalt und datei 1 aufgelistet.

[jaenicke]

Dann musst du wohl durchdebuggen warum, denn bei mir funktioniert es. Ich habe das Ding auf zwei meiner FTP-Server losgelassen.

Aber ich schaue nochmal. ;-)