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

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

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