Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.01.17;
Скачать: CL | DM;

Вниз

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

 
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 все равно иногда бывает ошибка, тут уж дело каждого писать не оставив места для ошибки и на авось.



Страницы: 1 вся ветка

Текущий архив: 2002.01.17;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.008 c
3-52480
grab
2001-12-14 20:05
2002.01.17
как закачать в stringgrid данные из Excel


3-52523
Alexandr
2001-12-14 10:03
2002.01.17
ZEOS


14-52658
p@s
2001-11-22 09:12
2002.01.17
Генератор отчетов.


14-52653
lel
2001-11-22 11:37
2002.01.17
Не понял библиотека ЕhLib , теперь небесплатная и бех исходников что ли???


1-52582
Sym
2001-12-19 16:06
2002.01.17
Народ помогите!!!!!!!!!!!!!! За ранее СПАСИБО