Поиск папок

← →
Steep (2007-10-27 20:53) [0]

что-то никак не соображу как сделать поиск подпапок по заданой папке...
т.е. поиск не файлов в папке или подпапках - а просто вывести название всех подпапок (надеюсь понятно объяснил)

пока единственное что сделал это :

задаю папку например C:\WINDOWS\system32\ в Edit1

procedure LookAll(path, mask: string);
var
sr: TSearchRec;
begin
if FindFirst(path {+ "\"} + mask, faAnyFile, sr) = 0 then
begin
repeat
if faDirectory <> 0 then //папка
begin
//пока выводим полный путь
form1.Memo1.Lines.Add(path + sr.name)
end;
until FindNext(sr) <> 0;
end;
FindClose(sr);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
LookAll( Edit1.Text, ".."); //.. - папка
end;

в итоге он находит C:\WINDOWS\system32\WINDOWS
а если писать C:\WINDOWS\system32 то C:\WINDOWS\system32\system32

чето нифига не понимаю....

← →
Anatoly Podgoretsky © (2007-10-27 21:07) [1]

> Steep (27.10.2007 20:53:00) [0]

Второй параметр должен быть МАСКОЙ

← →
Steep (2007-10-27 21:14) [2]

ну да - потому задаю параметр .. - папке же обозначается как ..?

← →
Джо © (2007-10-27 21:17) [3]

> [2] Steep (27.10.07 21:14)
> ну да - потому задаю параметр .. - папке же обозначается
> как ..?

Не знаю, как обозначается папке же, однако, в данном случае (любое имя/любое расширение), должна иметь вид *.*

← →
Steep (2007-10-27 21:25) [4]

а все понял .. - это же предыдущий каталог! - ступил :)))
Спасибо вам большое!

← →
Steep (2007-10-27 22:09) [5]

а не все так просто как казалось - а как исключить файлы?

← →
Anatoly Podgoretsky © (2007-10-27 22:15) [6]

У файлов нет аттрибута Directory

← →
Плохиш © (2007-10-27 23:43) [7]

> if faDirectory <> 0 then //папка

Мне понравилось :-))

← →
Johnmen © (2007-10-28 00:11) [8]

Ага, товарищ думает, что окромя файлов и папок ничего не бывает. Наивный...

← →
Steep (2007-10-28 00:25) [9]

вот что получилось....
не знаю насколько я верно сделал но вроде рабоает :)

////////////////// Поиск подпапок в папке \\\\\\\\\\\\\\\\\\\\\\\\\ procedure LookAll(path, mask: string); var sr: TSearchRec; FileAttrs: Integer; begin //Если нет косой черты - добавляем if (path <> "") and (path[Length(path)] <> "\") then path := path + "\"; //Атрибуты FileAttrs := faDirectory; //Поиск if ( FindFirst(path + mask, FileAttrs{faDirectory}, sr) = 0 ) then begin // если найдена папка repeat // повторять // делаем с файлом что хотим, обращаясь к нему, как (path + "\" + sr.name) if sr.Attr and faDirectory = 16 then //здесь типа директории if (sr.name<>"..") and (sr.name<>".") then begin form1.Memo1.Lines.Add(path + sr.name); //Полный путь //form1.Memo1.Lines.Add(sr.name); //Название каталога end; until FindNext(sr) <> 0; // пока есть ссылка на следующий файл end; FindClose(sr); end; procedure TForm1.Button2Click(Sender: TObject); begin LookAll( Edit1.Text, "*.*"); end; //\\\\\\\\\\\\\\\\\\\\\\\\\ Поиск подпапок в папке ////////////////

← →
Германн © (2007-10-28 01:08) [10]

> не знаю насколько я верно сделал но вроде рабоает :)
>

Не изящно, да и не совсем верно. Работать будет не всегда.

← →
Джо © (2007-10-28 01:21) [11]

> //Если нет косой черты - добавляем
> if (path <> "") and (path[Length(path)] <> "\") then path
> := path + "\";

Path := IncludeTrailingPathDelimiter (Path);

-

> if sr.Attr and faDirectory = 16

if (sr.Attr and faDirectory) = faDirectory then

← →
Германн © (2007-10-28 01:41) [12]

> Джо © (28.10.07 01:21) [11]

Есть ещё одна "неизящность". Имхо begin перед repeat некрасиво смотрится.

← →
sniknik © (2007-10-28 02:06) [13]

> Имхо begin перед repeat некрасиво смотрится.
мало ли как смотрится, он нужен для FindClose(sr);... а вот то, что FindClose(sr); не внутри этого блока это уже "глючок" (ненужный вызов будет делаться при не найденности ни одного файла).

и еще я бы переставил местами проверки, не глюк но... не то чтобы я такой поборник оптимизаций на спичках, но всетаки.
if (sr.name<>"..") and (sr.name<>".") then

а вот это form1.Memo1.Lines уже просто "глаз режет"... не должно быть таких обращений в функциях, если это совершенно отдельная функция (типа в модуле утилит) то меняемый Lines должен передаваться в параметрах, если же это функция класса Tform1 то тогда обращение к глобальной form1 надо просто убрать.
и кстати, может и не по логике в данном случае, но чаще всего Lines надо очищать перед работой.

ну и д кучи, FileAttrs переменная лишняя.

← →
Steep (2007-10-28 02:13) [14]

> Работать будет не всегда.

а почему?

> Path := IncludeTrailingPathDelimiter (Path); >if (sr.Attr and faDirectory) = faDirectory then

Спасибо!

> Имхо begin перед repeat некрасиво смотрится.

а.. ну там отладка была :)

← →
Steep (2007-10-28 02:21) [15]

> и еще я бы переставил местами проверки, не глюк но... не
> то чтобы я такой поборник оптимизаций на спичках, но всетаки.
> if (sr.name<>"..") and (sr.name<>".") then

не совсем понял...

> а вот это form1.Memo1.Lines уже просто "глаз режет"... не
> должно быть таких обращений в функциях, если это совершенно
> отдельная функция (типа в модуле утилит) то меняемый Lines
> должен передаваться в параметрах, если же это функция класса
> Tform1 то тогда обращение к глобальной form1 надо просто
> убрать.

ну просто я не умею по другому - хотел функцией - но там же много данных возвращается....

> Lines надо очищать перед работой.

учту..

> FileAttrs переменная лишняя.

Использовалось для иксперементов - думал что есть написать
FileAttrs := faDirectory то будет искать только папки - но такого не произошло...
уберу

Спасибо всем большое за помощь!

← →
Германн © (2007-10-28 02:25) [16]

> Steep (28.10.07 02:13) [14]
>
>
> > Работать будет не всегда.
>
> а почему?
>

Потому что параметр "path" берётся из компоненты TEdit. А будет ли в ней существующая реально папка или не существующая, не проверяется. А очепятки при вводе с клавиатуры - обычное явление. Во втором случае не найдётся ничего. И сообщений об ошибках никаких. Пользователь получит ответ, что никаких папок нет. И даже не узнает, что это он сам ошибся!

← →
sniknik © (2007-10-28 02:31) [17]

> не совсем понял...
проверка слева направо, и при and если первое false то прекращается.

> ну просто я не умею по другому
procedure LookAll(lines: TString; const path, mask: string); ... Lines.Add(path + sr.name); //Полный путь ... procedure TForm1.Button2Click(Sender: TObject); begin LookAll(Memo1.Lines, Edit1.Text, "*.*"); end;

← →
sniknik © (2007-10-28 02:32) [18]

lines: TStrings

← →
Германн © (2007-10-28 02:38) [19]

> sniknik © (28.10.07 02:06) [13]
>
> > Имхо begin перед repeat некрасиво смотрится.
> мало ли как смотрится, он нужен для FindClose(sr);... а
> вот то, что FindClose(sr); не внутри этого блока это уже
> "глючок" (ненужный вызов будет делаться при не найденности
> ни одного файла).

Ты, конечно, мастер. Но гложат меня смутные сомнения. :)
Я до сих пор считал, что FindClose нужен всегда, если начат поиск! Т.е. Если вызвана была функция FindFirst.
P.S.
Из справки Д6:
Note: FindFirst allocates resources (memory) which must be released by calling FindClose.

← →
sniknik © (2007-10-28 02:45) [20]

> Из справки Д6:

а вот из генофонда D7, проверь в D6
function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer; const faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; begin F.ExcludeAttr := not Attr and faSpecial; F.FindHandle := FindFirstFile(PChar(Path), F.FindData); if F.FindHandle <> INVALID_HANDLE_VALUE then begin Result := FindMatchingFile(F); if Result <> 0 then FindClose(F); end else Result := GetLastError; end;

← →
Джо © (2007-10-28 02:45) [21]

Удалено модератором
Примечание: Промахнулся :)

procedure FindClose(var F: TSearchRec); begin {$IFDEF MSWINDOWS} if F.FindHandle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(F.FindHandle); F.FindHandle := INVALID_HANDLE_VALUE; end; {$ENDIF} {$IFDEF LINUX} if F.FindHandle <> nil then begin closedir(F.FindHandle); F.FindHandle := nil; end; {$ENDIF} end;

> Все-таки не «глючок», а «неизящность» :)
как ни назови... суть я обьяснил - ненужный вызов функции.

← →
Steep (2007-10-28 02:50) [24]

> Потому что параметр "path" берётся из компоненты TEdit.
> А будет ли в ней существующая реально папка или не существующая,
> не проверяется. А очепятки при вводе с клавиатуры - обычное
> явление. Во втором случае не найдётся ничего. И сообщений
> об ошибках никаких. Пользователь получит ответ, что никаких
> папок нет. И даже не узнает, что это он сам ошибся!

а ну это пока он берется оттуда :)))
я для наглядности пока сам ввожу - потом будет браться стандартная системная папка из реестра.
А вобще спасибо за коментарии на будущее учту о проверках

> sniknik ©

А почему const path?
это означает что он никогда не меняется в этой процедуре?

Спасибо за помощь - не знал что можно данные из процедурки по другому забирать....

> А почему const path?
> это означает что он никогда не меняется в этой процедуре?
ну это больше для программиста ограничение, контроль самого себя, чтоб не менял если по логике не должен. а сдесь не меняется.
но вообще, оптимизаторы сейчас хорошие они и без const тот же код сделают если изменений внутри нет. (что не значит, что писать можно абы как)

> sniknik © (28.10.07 02:45) [20]
>
> > Из справки Д6:
>
> а вот из генофонда D7, проверь в D6
>

Проверил. Даже и в Д4 ты прав.

> Есть ещё одна "неизящность". Имхо begin перед repeat некрасиво
> смотрится.

Он нормально смотрится и нужен, а вот FindClose не там стоит.

> не внутри этого блока это уже "глючок" (ненужный вызов будет
> делаться при не найденности ни одного файла).

Дело даже не в ненужности, а то что на определенных версиях Дельфи будет исключение.

> Я до сих пор считал, что FindClose нужен всегда, если начат
> поиск! Т.е. Если вызвана была функция FindFirst.
> P.S.
> Из справки Д6:
> Note: FindFirst allocates resources (memory) which must
> be released by calling FindClose.

Если вернется не 0, то ресурсы не будут выделены и освобождать их не надо, а иногда и нельзя, в Д3 из-за этого возникала ошибка.

← →
Steep (2007-10-29 07:56) [30]

Большое всем спасибо!!!

Поиск папок Найти похожие ветки