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. я его честно где-то стащил. 🙂
32 thoughts on “ Delphi. Получение списка всех файлов в папке и ее подпапках. ”
isFound := FindFirst( Path + ‘\\\\*.*’, faAnyFile, sRec ) = 0; Я не прогер и поэтому все что увидел в этой строке это целых два смайлика, а автор поста их тут увидит, интересно? А то ведь мы видим только то что привыкли. Можно еще пару символов за смайл принять, но как то не особо.
Ну приглядевшись, смайлики конечно видно.
Так же как узоры букв в книге если её не читать, а рассматривать.
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;
Хорошо, но не то. Код в посте заходит в папки. И выдает полное дерево. Твой, нет.
Этот гнилой код заполонил весь Интернет. Он заходит только в одну подпапку!
В середине есть строки
if ( sRec.Attr and faDirectory ) = faDirectory then GetAllFiles( Path + ‘\’ + sRec.Name, Lb );
догадайтесь зачем они вставлены.
Сейчас еще раз проверил. Собирает всю структуру.
Вы бы лучше разбирались почему у вас это не работает, а не код винили. Ибо код довольно простой и понятный.
А если нужно добавить только файлы с расширением mp3 помоги плз ото я не понял этот код
Бауыржан, попробуй вместо 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 справишься или условие тоже подсказать?
Спс теперь у меня другая проблема есть папка «музыка» внутри музыки есть папка «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;
верни код как было используй то, что в посте с ‘\*.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 );
Спс тебе Большое . Все получилось 🙂
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;
Автору большое спасибо, очень помогло. Очень много тех, кто не любит работать с ФС, то что нужно! )))
Сам периодически нахожу эту статью на блоге, чтобы скопировать код )))
А как исправить код, чтобы он искал файлы с именем вроде ‘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); (вылезалет ошибка, что файл не найден)
У вас сразу три ошибки.
Первая, в таком виде код будет искать один файл, ведь вы превратили его в функцию, следовательно и вывод будет один.
Вторая такая же как в комментах выше. Чтобы выбрать файл start.txt надо после рекурсивного вызова писать код
Посмотрите комменты. Тут я привел пример для процедуры, которая ищет файлы, а не функции которая ищут один.
Ну и самая не очевидная. Третья. Если файл находится не в головной папке, а где то в глубине, то функция не сможет вытащить результат из глубин рекурсии.
Поэтому самый простой вариант использовать ее как процедуру в том виде, как она записана у меня. Просто прописав условие на файл, код я дал, а примеры в комментах выше есть.
Однако пока я разбирался, я написал нужную функцию, поэтому вот код:
Учитывайте цифры в функции pos(‘\start.txt’,copy(s, length(s)-9,10)) 10 это длина переменной, 9 просто на единичку меньше. Слэш берем, чтобы не выбирать файлы типа «11start.txt»
___ Еше одно незначительное. Вызывая функцию не обязательно ставить слеш в конце, слеш прикручивает сама функция в строке isFound := FindFirst( Path + ‘\*.*’, faAnyFile, sRec ) = 0;
ВСЕ БЫ ХОРОШО, НО В ДЕЛЬФИ НЕТ ХВОСТОВОЙ РЕКУРСИИ, А ЗНАЧИТ ПРИ БОЛЬШОМ КОЛИЧЕСТВЕ ПАПОК БУДЕТ ВЫЛЕТАТЬ ПЕРЕПОЛНЕНИЕ СТЕКА.
Даже не знал о таких вещах. ) Но как я понял стек не фиксированный, а резиновый. Зависит от памяти. И даже сотня папок ему не помеха.
Если стек фиксированный, то поправьте меня, буду иметь ввиду.
привет, ты не встречался с такой ситуацией искал похожим кодом получается такая фигня — на диске С поиск доходит до папки ‘В.Высоцкий(Е)’, просматривает ее и поиск заканчиваетя, хотя там еще уча файлов и папок. при поиске на диске D доходит до папки Photoshop просматривает ее и аналогично заканчивает поиск. искал в других папках — ищет все нормально, находит все файлы и папки. т.е. глюк возникает только в локальных дисках.
Если код похожий, а не такой же, то скинь, глянем. Проверил код у себя. Нашел все файлы и папки.
привет. отправлю тебе весь код на форму закинь три кнопки , поле ввода edit1, листбокс listbox1 и метку label1
первая кнопка button1 отвечает за закрытие окна вторая button2 отвечает за поиск третья button3 за очистку метки и листбокса
в edit1 напиши с:\\ Проверки на наличие отсутсвие слеша \ у меня нет, не забудь поставить его в конце
если что не поймешь спроси
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);
var Form1: TForm1;
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
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;
О мои глаза, ну и код… Я конечно сам пишу ужасно, но создавать процедуры под две строки, используемые один раз, или добавлять переменную и удалять ее после проверки, вместо того, сначала проверить и не добавлять, это выше моего понимания.
Так же не понимаю что именно делает программа, и почему не использовать для этого код, приведенный в посте.
У вас программа то выполняется, а не выдает ошибку. Значит ошибка в логике кода. Завершение у вас идет если функция findfirst(strokapoiska+’*.*’,faanyfile,info) выдает код, отличный от нуля. Именно это она и делает иногда. Поэтому или переписать, так, чтобы не было такой жесткой зависисомости от этой функции. Или слегка изменить процедуру, что в посте, прибавить inttostr(Lb.Items.count) для нумерации и проверку «не каталог», чтобы добавлять в список только файлы.
спасибо. учусь по самоучителю, большого опыта нет поэтому и код такой :). прграмма все файлы отправляет в листбокс а папки в текстовый файл. из текстового файла берет снизу название папки и ищет в этой папке.Потом удаляет нижнюю строчку в файле. решил так сделать потому что рекурсия очень не понравилась, а использовать вместо файла сам листбокс не пришло в голову.
Это я понял. Проблема, как я уже сказал, в том, что функция не всегда выдает ноль. А код это не учитывает, и если какая-то папка не дает доступа, то останавливается. Ну и файл log.txt тут на самом деле никак не участвует. Он создается, висит пустой, и удаляется. Можно было просто работать по процедурам logfail.LoadFromFile(‘log.txt’); для загрузки данных из файла и logfail.SaveToFile(‘log.txt’); для создания файла или сохранения данных. Все, никаких дополнительных операций с log.txt в этом случае можно не делать. И если прикрутить все же сохранение в конце циклов, то можно будет видеть на какой папке споткнулся.
строчку while findfirst(strokapoiska+’*.*’,faanyfile,info)=0 do заменил на
while true do begin findfirst(strokapoiska+’*.*’,faanyfile,info); … … окончание цикла производится breakОМ после того как все строчки закончатся.
с процедурами logfail.LoadFromFile(‘log.txt’)и logfail.SaveToFile(‘log.txt’)сейчас буду разбираться куда пристроить.
спсибо огромное,а то я уже даже отчаиваться начал.
А задача у вас простая, так, что ее так и так на большинстве программистских форумов помогли бы решить.
Можете подсказать как сделать чтоб как-то выводилось на экран.мемо,лейбл или еще что-то. Есть программа,отправляет файлы на фтп нормально,но там надо задавать строго,определенную папку,хотелось бы с помощью этого кода решить эту задачу,ниже код отправления на сервер файла 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(‘загружен’);
Боюсь я не совсем понял задачу. Но если речь о выводе списка папок и файлов, расположенных на FTP, то я этого никогда не делал, и изучать работу с FTP мне откровенно лень.
А СКАЖИТЕ,МОЖНО КАК-ТО ПРОГРЕСС БАР ПРИСОЕДЕНИТЬ К ПОИСКУ ФАЙЛА?просто когда очень долго ищет хотелось бы знать идет процесс,или он ничего не делает
Между 12 и 13 строчкой процедуры нужно добавить else и убрать перед ней ; — иначе добавляет в список ещё и путь к папкам…