Delphi. Получение списка всех файлов в папке и ее подпапках.

Почему то никогда не любил работать с файловой системой, поэтому код представленный ниже я предпочел бы иметь в готовом виде, а не писать заново при необходимости.

Поэтому оставлю его здесь.

procedure GetAllFiles( Path: string; Lb: TListBox );
var
sRec: TSearchRec;
isFound: boolean;
begin
isFound := FindFirst( Path + ‘\*.*’, faAnyFile, sRec ) = 0;
while isFound do
begin
if ( sRec.Name <> ‘.’ ) and ( sRec.Name <> ‘..’ ) then
begin
if ( sRec.Attr and faDirectory ) = faDirectory then
GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
Lb.Items.Add( Path + ‘\’ + sRec.Name );
end;
Application.ProcessMessages;
isFound := FindNext( sRec ) = 0;
end;
FindClose( sRec );
end;

И вызов что-нибудь типа:  GetAllFiles( ‘C:\’, listbox1 );

p.s. я его честно где-то стащил. 🙂


Автор: Elsper.ru


VN:F [1.9.14_1148]
Rating: 8.0/10 (7 votes cast)
Delphi. Получение списка всех файлов в папке и ее подпапках., 8.0 out of 10 based on 7 ratings

32 thoughts on “Delphi. Получение списка всех файлов в папке и ее подпапках.

  1. isFound := FindFirst( Path + ‘\\\\*.*’, faAnyFile, sRec ) = 0; Я не прогер и поэтому все что увидел в этой строке это целых два смайлика, а автор поста их тут увидит, интересно? А то ведь мы видим только то что привыкли. Можно еще пару символов за смайл принять, но как то не особо.

  2. Ну приглядевшись, смайлики конечно видно.

    Так же как узоры букв в книге если её не читать, а рассматривать.

  3. var sr: TSearchRec;
    begin
    Memo1.Clear;
    if FindFirst(‘C:\*.*’, faAnyFile, sr) = 0 then
    begin
    repeat
    Memo1.Lines.Add(sr.Name);
    until FindNext(sr) 0;
    FindClose(sr);
    end;
    end;

  4. Этот гнилой код заполонил весь Интернет.
    Он заходит только в одну подпапку!

  5. Лолчто???

    В середине есть строки

    if ( sRec.Attr and faDirectory ) = faDirectory then
    GetAllFiles( Path + ‘\’ + sRec.Name, Lb );

    догадайтесь зачем они вставлены.

  6. Сейчас еще раз проверил. Собирает всю структуру.

    Вы бы лучше разбирались почему у вас это не работает, а не код винили. Ибо код довольно простой и понятный.

  7. А если нужно добавить только файлы с расширением mp3
    помоги плз ото я не понял этот код

  8. Бауыржан, попробуй вместо
    isFound := FindFirst( Path + ‘\*.*’, faAnyFile, sRec ) = 0;

    написать

    isFound := FindFirst( Path + ‘\*.mp3’, faAnyFile, sRec ) = 0;

    и между строками

    GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
    Lb.Items.Add( Path + ‘\’ + sRec.Name );

    вставить условие проверки имени файла sRec.Name справишься или условие тоже подсказать?

  9. Спс теперь у меня другая проблема есть папка «музыка» внутри музыки есть папка «Club» если выделить музыку то добавляются файлы которые находится в «Музыка» а те которые находиться в «Club» не добавляются уфф ели как объяснил :-)))

    procedure GetAllFiles( Path: string; Lb: TListBox );
    var
    sRec: TSearchRec;
    isFound: boolean;
    begin
    isFound := FindFirst( Path + ‘\*.mp3’, faAnyFile, sRec ) = 0;
    while isFound do
    begin
    if ( sRec.Name ‘.’ ) and ( sRec.Name ‘..’ ) then
    begin
    if ( sRec.Attr and faDirectory ) = faDirectory then
    GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
    Lb.Items.Add( Path + ‘\’ + sRec.Name );
    end;
    Application.ProcessMessages;
    isFound := FindNext( sRec ) = 0;
    end;
    FindClose( sRec );
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    GetAllFiles( ‘E:\музыка’, listbox1 );
    end;

    end.

  10. верни код как было используй то, что в посте
    с ‘\*.mp3’ косяк выходит

    но вместо

    GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
    Lb.Items.Add( Path + ‘\’ + sRec.Name );

    поставь

    GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
    if pos(‘.mp3’,copy(sRec.Name, length(sRec.Name)-3,4))=1 then
    Lb.Items.Add( Path + ‘\’ + sRec.Name );

  11. Спс тебе Большое !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Все получилось 🙂

    procedure GetAllFiles( Path: string; Lb: TListBox );
    var
    sRec: TSearchRec;
    isFound: boolean;
    begin
    isFound := FindFirst( Path + ‘\*.*’, faAnyFile, sRec ) = 0;
    while isFound do
    begin
    if ( sRec.Name ‘.’ ) and ( sRec.Name ‘..’ ) then
    begin
    if ( sRec.Attr and faDirectory ) = faDirectory then
    GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
    if pos(‘.mp3’,copy(sRec.Name, length(sRec.Name)-3,4))=1 then
    Lb.Items.Add( Path + ‘\’ + sRec.Name );
    if pos(‘.AAC’,copy(sRec.Name, length(sRec.Name)-3,4))=1 then
    Lb.Items.Add( Path + ‘\’ + sRec.Name );
    end;
    Application.ProcessMessages;
    isFound := FindNext( sRec ) = 0;
    end;
    FindClose( sRec );
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var dir: String;
    pwRoot : PWideChar;
    begin
    if not SelectDirectory(‘Выберите папку с музыкальными файлами’, pwRoot, Dir)
    then Dir :=»
    else Dir := Dir+»;

    GetAllFiles( dir, listbox1 );
    end;

    end.

  12. Автору большое спасибо, очень помогло. Очень много тех, кто не любит работать с ФС, то что нужно! )))

  13. А как исправить код, чтобы он искал файлы с именем вроде ‘start.txt’

    function GetAllFiles(Path: string):String;
    var
    sRec: TSearchRec;
    isFound: boolean;
    begin
    isFound := FindFirst( Path + ‘\start.txt’, faAnyFile, sRec ) = 0;
    while isFound do
    begin
    if ( sRec.Name ‘.’ ) and ( sRec.Name ‘..’ ) then
    begin
    if ( sRec.Attr and faDirectory ) = faDirectory then
    GetAllFiles( Path + ‘\’ + sRec.Name);
    Result:=( Path + ‘\’ + sRec.Name );
    end;
    Application.ProcessMessages;
    isFound := FindNext( sRec ) = 0;
    end;
    FindClose( sRec );
    end;

    в самой программе

    q:=GetAllFiles(‘E:\’);
    AssignFile(FileVersionUser, q);
    Reset(FileVersionUser); (вылезалет ошибка, что файл не найден)

  14. У вас сразу три ошибки.

    Первая, в таком виде код будет искать один файл, ведь вы превратили его в функцию, следовательно и вывод будет один.

    Вторая такая же как в комментах выше.
    Чтобы выбрать файл start.txt надо после рекурсивного вызова писать код

    if sRec.Name = 'start.txt' then
    Lb.Items.Add( Path + '\' + sRec.Name );

    Посмотрите комменты. Тут я привел пример для процедуры, которая ищет файлы, а не функции которая ищут один.

    Ну и самая не очевидная. Третья. Если файл находится не в головной папке, а где то в глубине, то функция не сможет вытащить результат из глубин рекурсии.

    Поэтому самый простой вариант использовать ее как процедуру в том виде, как она записана у меня. Просто прописав условие на файл, код я дал, а примеры в комментах выше есть.

    Однако пока я разбирался, я написал нужную функцию, поэтому вот код:

    function GetAllFiles(Path: string):String;
    var
    sRec: TSearchRec;
    isFound: boolean;
    s:string;
    begin
    isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0;
    while isFound do
    begin
    if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then
    begin
     
    if ( sRec.Attr and faDirectory ) = faDirectory then 
    begin
    s:=GetAllFiles( Path + '\' + sRec.Name);
    if pos('\start.txt',copy(s, length(s)-9,10))=1 then
    begin
    Result:=s;
    exit;
    end;   
    end;
     
    if sRec.Name='start.txt' then
    begin
    Result:=( Path + '\' + sRec.Name );
    exit;
    end;
     
    end;
    Application.ProcessMessages;
    isFound := FindNext( sRec ) = 0;
    end;
    FindClose( sRec );
    end;

    Учитывайте цифры в функции pos(‘\start.txt’,copy(s, length(s)-9,10))
    10 это длина переменной, 9 просто на единичку меньше. Слэш берем, чтобы не выбирать файлы типа «11start.txt»

    ___
    Еше одно незначительное.
    Вызывая функцию не обязательно ставить слеш в конце, слеш прикручивает сама функция в строке isFound := FindFirst( Path + ‘\*.*’, faAnyFile, sRec ) = 0;

  15. ВСЕ БЫ ХОРОШО, НО В ДЕЛЬФИ НЕТ ХВОСТОВОЙ РЕКУРСИИ, А ЗНАЧИТ ПРИ БОЛЬШОМ КОЛИЧЕСТВЕ ПАПОК БУДЕТ ВЫЛЕТАТЬ ПЕРЕПОЛНЕНИЕ СТЕКА!!!

  16. Даже не знал о таких вещах. )
    Но как я понял стек не фиксированный, а резиновый. Зависит от памяти. И даже сотня папок ему не помеха.

    Если стек фиксированный, то поправьте меня, буду иметь ввиду.

  17. привет, ты не встречался с такой ситуацией искал похожим кодом получается такая фигня — на диске С поиск доходит до папки
    ‘В.Высоцкий(Е)’, просматривает ее и поиск заканчиваетя, хотя там еще уча файлов и папок. при поиске на диске D доходит до папки Photoshop просматривает ее и аналогично заканчивает поиск. искал в других папках — ищет все нормально, находит все файлы и папки. т.е. глюк возникает только в локальных дисках.

  18. Если код похожий, а не такой же, то скинь, глянем.
    Проверил код у себя. Нашел все файлы и папки.

  19. привет.
    отправлю тебе весь код
    на форму закинь три кнопки , поле ввода edit1, листбокс listbox1 и метку label1

    первая кнопка button1 отвечает за закрытие окна
    вторая button2 отвечает за поиск
    третья button3 за очистку метки и листбокса

    в edit1 напиши с:\\ Проверки на наличие отсутсвие слеша \ у меня нет, не забудь поставить его в конце

    если что не поймешь спроси

    unit findTEXT;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, Menus, StdCtrls;

    type
    TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    Button2: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);

    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    close;
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    var sozdaniefaila:tfilestream;//создание файла независимо от всего
    logfail:TstringList; // используем эту переменнкю для ввода в файл поисковых данных
    info: Tsearchrec; //переменная для поиска
    tekkatalogiimja:string;//текущий каталог + имя файла
    strokapoiska:string;// сюда записвыаем где надо искать
    schet:longint; // счетчик найденных файлов

    procedure sozdfaila;// текстовый файл для поиска создается именно в текущем каатлоге
    begin
    tekkatalogiimja:=GetCurrentDir+’\log.txt’;// присвоение текущего каталога и имени файла
    sozdaniefaila:=tfilestream.create(tekkatalogiimja,fmcreate);//создание файла log.txt в текущем каталоге
    sozdaniefaila.free;// сохранение файла и осовбождени оперативной памяти
    end;

    procedure initializazijalogfaila; //инициализация переменной logfail
    begin
    logfail:=tstringList.Create(); //инициализация переменной logfail
    logfail.LoadFromFile(tekkatalogiimja); // связываание переменной с реальным файлом
    end;

    procedure vivodvlistbox; //выыодит в листбокс имя найденного файла и номер а в метку — общее число найденных файлов
    begin
    schet:=schet+1;
    listbox1.Items.Add(inttostr(schet)+’ ‘+strokapoiska+info.Name);
    label1.Caption:=inttostr(schet);
    end;

    begin
    schet:=0; //остановка счетчика файлов в ноль
    sozdfaila; // создание файла log.txt в текущем каталоге
    initializazijalogfaila; //инициализация этого файла
    strokapoiska:=edit1.text; // в папке, заданной строкойпоиска начнется поиск

    while findfirst(strokapoiska+’*.*’,faanyfile,info)=0 do
    // цикл начинается когда в текущей папке больше
    //нет файлов никаких и идет перход в другую папку
    begin

    if (info.Attr and faDirectory)=faDirectory //если первый файл это папка …
    then //то
    begin
    logfail.Add(strokapoiska+info.name+’\’) //добваляем файл в логфайл
    end
    else //иначе добавляем найденный файл в листбокс ;
    vivodvlistbox;

    if (info.name=’.’) or (info.name=’..’)//если первый файл так зовут…
    then
    begin
    logfail.delete(logfail.count-1); //то удаляем последнюю запись в логфайле
    end;

    while findnext(info)=0 do
    // пока в текущей папке находятся фалйы
    begin

    if (info.Attr and faDirectory)=faDirectory
    then //если найденный файл это папка то добавляем ее в логфайл
    begin
    logfail.Add(strokapoiska+info.name+’\’) //добваляем файл в логфайл
    end
    else //иначе добавляем найденный файл в листбокс
    vivodvlistbox;

    if (info.name=’.’) or (info.name=’..’)//если файл так зовут…
    then
    logfail.delete(logfail.count-1); //то удаляем последнюю запись в логфайле

    end;//конец второго while

    if logfail.count=0 //если логфайл пуст
    then //то
    break; // выход из всех циклов

    strokapoiska:=logfail.strings[logfail.count-1];//строке поиска присваивается значение последней строки в логфайле
    logfail.delete(logfail.count-1); //после этоо последняя строка удаляется из логфайла
    findclose(info); //освобождается память

    end;//конец первого while

    end;

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    //после окночания поиска удаление текстового файла
    begin
    deletefile(GetCurrentDir+’\log.txt’)// удаление файла из текущего каталога
    end;

    procedure TForm1.Button3Click(Sender: TObject); // очмстка всех полей кроме строки ввода
    begin
    listbox1.items.clear;
    label1.Caption:=»;
    end;

    end.

  20. О мои глаза, ну и код… Я конечно сам пишу ужасно,
    но создавать процедуры под две строки, используемые один раз, или добавлять переменную и удалять ее после проверки, вместо того, сначала проверить и не добавлять, это выше моего понимания.

    Так же не понимаю что именно делает программа, и почему не использовать для этого код, приведенный в посте.

    У вас программа то выполняется, а не выдает ошибку. Значит ошибка в логике кода. Завершение у вас идет если функция findfirst(strokapoiska+’*.*’,faanyfile,info) выдает код, отличный от нуля. Именно это она и делает иногда. Поэтому или переписать, так, чтобы не было такой жесткой зависисомости от этой функции.
    Или слегка изменить процедуру, что в посте, прибавить inttostr(Lb.Items.count) для нумерации и проверку «не каталог», чтобы добавлять в список только файлы.

  21. спасибо. учусь по самоучителю, большого опыта нет поэтому и код такой :). прграмма все файлы отправляет в листбокс а папки в текстовый файл. из текстового файла берет снизу название папки и ищет в этой папке.Потом удаляет нижнюю строчку в файле. решил так сделать потому что рекурсия очень не понравилась, а использовать вместо файла сам листбокс не пришло в голову.

  22. Это я понял. Проблема, как я уже сказал, в том, что функция не всегда выдает ноль. А код это не учитывает, и если какая-то папка не дает доступа, то останавливается.
    Ну и файл log.txt тут на самом деле никак не участвует. Он создается, висит пустой, и удаляется.
    Можно было просто работать по процедурам logfail.LoadFromFile(‘log.txt’); для загрузки данных из файла и logfail.SaveToFile(‘log.txt’); для создания файла или сохранения данных. Все, никаких дополнительных операций с log.txt в этом случае можно не делать. И если прикрутить все же сохранение в конце циклов, то можно будет видеть на какой папке споткнулся.

  23. строчку
    while findfirst(strokapoiska+’*.*’,faanyfile,info)=0 do
    заменил на

    while true do
    begin
    findfirst(strokapoiska+’*.*’,faanyfile,info);


    окончание цикла производится breakОМ после того как все строчки закончатся.

    работает офигенно

    с процедурами logfail.LoadFromFile(‘log.txt’)и logfail.SaveToFile(‘log.txt’)сейчас буду разбираться куда пристроить.

    спсибо огромное,а то я уже даже отчаиваться начал.

  24. Хорошо. )

    А задача у вас простая, так, что ее так и так на большинстве программистских форумов помогли бы решить.

  25. Можете подсказать как сделать чтоб как-то выводилось на экран.мемо,лейбл или еще что-то.
    Есть программа,отправляет файлы на фтп нормально,но там надо задавать строго,определенную папку,хотелось бы с помощью этого кода решить эту задачу,ниже код отправления на сервер файла
    IdFTP1.Host:=’хост’;
    IdFTP1.Port:=21;
    IdFTP1.Username:=’логин’;
    IdFTP1.Password:=’пасс’;
    try
    IdFTP1.Connect;
    sleep(1000);
    IdFTP1.ChangeDir(‘/’);
    except
    if idftp1.connected then
    IdFTP1.Put(‘полный путь к файлу’,’с каким именем на хосте сохранит’, true);
    showmessage(‘загружен’);

  26. Боюсь я не совсем понял задачу.
    Но если речь о выводе списка папок и файлов, расположенных на FTP, то я этого никогда не делал, и изучать работу с FTP мне откровенно лень.

  27. А СКАЖИТЕ,МОЖНО КАК-ТО ПРОГРЕСС БАР ПРИСОЕДЕНИТЬ К ПОИСКУ ФАЙЛА?просто когда очень долго ищет хотелось бы знать идет процесс,или он ничего не делает

  28. Между 12 и 13 строчкой процедуры нужно добавить else и убрать перед ней ; — иначе добавляет в список ещё и путь к папкам…

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *

Спoнcopcкиe ссылки

папки с прижимом