Thema: Delphi Dateiliste mit TIdFTP

Einzelnen Beitrag anzeigen

Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.702 Beiträge
 
Delphi 11 Alexandria
 
#8

AW: Dateiliste mit TIdFTP

  Alt 24. Mär 2012, 06:48
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;
Sebastian Jänicke
AppCentral

Geändert von jaenicke (24. Mär 2012 um 07:03 Uhr)
  Mit Zitat antworten Zitat