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;