Почему то никогда не любил работать с файловой системой, поэтому код представленный ниже я предпочел бы иметь в готовом виде, а не писать заново при необходимости.
Поэтому оставлю его здесь.
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
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;
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;
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 напиши с:\\ Проверки на наличие отсутсвие слеша \ у меня нет, не забудь поставить его в конце
если что не поймешь спроси
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.
О мои глаза, ну и код… Я конечно сам пишу ужасно,
но создавать процедуры под две строки, используемые один раз, или добавлять переменную и удалять ее после проверки, вместо того, сначала проверить и не добавлять, это выше моего понимания.
Так же не понимаю что именно делает программа, и почему не использовать для этого код, приведенный в посте.
У вас программа то выполняется, а не выдает ошибку. Значит ошибка в логике кода. Завершение у вас идет если функция 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 и убрать перед ней ; — иначе добавляет в список ещё и путь к папкам…