Форум: "Основная";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.01.17;
Скачать: [xml.tar.bz2];




Вниз

Народ помогите!!!!!!!!!!!!!! За ранее СПАСИБО 


Sym   (2001-12-19 16:06) [0]

Блин Знаю как получить список файлов в папке но незнаю как получить список папок на диске подскажите пожалуйсто!!!



MBo   (2001-12-20 09:48) [1]

var sr:tsearchrec;
begin
if FindFirst("c:\*.*",faAnyFile, sr) = 0 then
if sr.Attr=faDirectory then Memo1.Lines.Add(sr.Name);
while FindNext(sr) = 0 do
if sr.Attr=faDirectory then Memo1.Lines.Add(sr.Name);
FindClose(sr);



Vitaly   (2001-12-20 09:53) [2]

Выдрано из консольного приложения:
Рекурсивно обходит все папки начиная с заданной.
Что-бы получить на всём диске - ScanDir("c:");

procedure ScanDir(dir: string);
var rc: integer;
sr: TSearchRec;
begin
writeln(dir); // печатается имя папки
rc := findFirst(dir + "\*.*", faAnyFile, sr);
while rc = 0 do begin
if (sr.Attr and faDirectory) <> 0 and // если папка
(sr.name[1] <> ".") and // и не текущая
(sr.name[1] <> "..") and // и не предыдущая
then scanDir(dir+"\"+sr.name); // смотрим подпапки
rc := findNext(sr);
end;
FindClose(sr);
end;



MBo   (2001-12-20 10:03) [3]

у меня почему-то так
FindFirst("c:\*.*",faDirectory, sr)
находит и файлы, так что приходится проверять.
а (Pos(".",Sr.Name)<=0)) - в имени дир. может быть и точка



MAGNUM   (2001-12-20 10:17) [4]

Ну вы ребята и молодцы, друг друга обсираете, а помочь не можете!
procedure FindDir(dir: string);
var rec: integer;
srec: TSearchRec;
begin
writeln(dir); // печатается имя папки
rec := findFirst(dir + "\*.*", faAnyFile, srec);
while rec = 0 do begin
if (srec.Attr and faDirectory) <> 0 and
(srec.name[1] <> ".") and
(srec.name[1] <> "..") and
then FindDir(dir+"\"+srec.name);
rec := findNext(srec);
end;
FindClose(srec);
end;

Все работает СУПЕР!



Vitaly   (2001-12-20 11:31) [5]

>Sym
procedure ScanDir(dir: string);
var rc: integer;
sr: TSearchRec;
begin
writeln(dir); // печатается имя папки
rc := findFirst(dir + "\*.*", faAnyFile, sr);
while rc = 0 do begin
if (sr.Attr and faDirectory) <> 0 and // если папка
(sr.name <> ".") and // и не текущая
(sr.name <> "..") and // и не предыдущая
then scanDir(dir+"\"+sr.name); // смотрим подпапки
rc := findNext(sr);
end;
FindClose(sr);
end;



Fast   (2001-12-24 03:05) [6]

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

procedure ScanDir(var list:TstringList; dir: string);
var rc: integer;
sr: TSearchRec;
begin
list.Add(dir); // добавляем имя папки
rc := findFirst(dir + "\*.*", faAnyFile, sr);
while rc = 0 do begin
if (sr.name <> ".") and (sr.name <> "..") //если не не текушая и не предыдущая папки
then if ((sr.Attr and faDirectory) <> 0) then scanDir(list,dir+"\"+sr.name) // если папка смотрим подпапки
else list.Add(dir+"\"+sr.name); //добавляем имя файла
rc := findNext(sr);
end;
FindClose(sr);
end;



Anatoly Podgoretsky   (2001-12-24 13:29) [7]

Многократно написано, что нельзя вызывать FindClose если findFirst вернул не ноль!
Надо использовать if блок
if rc = 0 then begin
...
end;



Vitaly   (2001-12-24 15:57) [8]

>Anatoly Podgoretsky © (24.12.01 13:29)

>Многократно написано, что нельзя вызывать FindClose если findFirst вернул
>не ноль!

IMHO, не нельзя, а не обязательно:
procedure FindClose(var F: TSearchRec);
begin
if F.FindHandle <> INVALID_HANDLE_VALUE then
begin
Windows.FindClose(F.FindHandle);
F.FindHandle := INVALID_HANDLE_VALUE;
end;
end;


Дальше два варианта:
1. Городить огород из условных конструкций.
2. Плюнуть на эффективность кода.



Anatoly Podgoretsky   (2001-12-24 18:34) [9]

Ты привел код из Д5, в более ранних версиях не так, но даже и в Д5 все равно иногда бывает ошибка, тут уж дело каждого писать не оставив места для ошибки и на авось.




Форум: "Основная";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.01.17;
Скачать: [xml.tar.bz2];




Наверх





Память: 0.74 MB
Время: 0.036 c
3-52454           Анастасия             2001-12-13 18:51  2002.01.17  
Помогите, пожалуйста, срочно!!!


3-52475           МАРАТ                 2001-12-14 14:56  2002.01.17  
Не могу открыть *.GDB


3-52490           Андре                 2001-12-14 11:50  2002.01.17  
Поля массивы в Interbase


3-52507           Softmaster            2001-12-16 14:46  2002.01.17  
Проблема с группировкой в отчете при использовании QReport


3-52493           andey                 2001-12-13 19:15  2002.01.17  
Где ошиика в запросе