Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.11.25;
Скачать: [xml.tar.bz2];

Вниз

Как прочитать _все_ директории на диске ?   Найти похожие ветки 

 
Дождь   (2002-11-14 01:52) [0]

Люди, помогите! Как лучше справиться с такой задачей: нужно создать дерево _всех_ каталогов на диске, сохранить его на диске, а потом при надобности загрузить и отобразить, например в DirectoryListBox1 из Win3.1? Ну очень надо!!!


 
Новенький в Делфи   (2002-11-14 03:55) [1]

насчёт всех директорий.. наверняка есть более оптимизированные процедуры, но я делаю так:


var Dir: TStringList;


procedure GetDir;
var rec: TSearchRec;
i:integer;
Brek:boolean;
begin
Dir.Add("c:\test\");// сюда добавляем стартовую директорию
repeat
brek:=true;
for i:=0 to Dir.Count-1 do
begin
Application.ProcessMessages;
if FindFirst(Dir.Strings[i]+"*.*", FaDirectory ,Rec)=0 then
repeat
Application.ProcessMessages;
if (Rec.Attr = faDirectory) and (Rec.Name<>".") and(REc.Name<>"..") and (Dir.IndexOf(Dir.Strings[i]+Rec.Name+"\")<0) then
begin
dir.Add(Dir.Strings[i]+Rec.Name+"\");
brek:=false;
end;
until FindNext(Rec)<>0;
FindClose(Rec);
end;
until brek;
end;

В итоге в Dir получается список всех директорий вместе с поддиреториями.

Не забудьте предварительно dir:= TStirngList.create;


 
Separator   (2002-11-14 06:21) [2]

В каком формате нужно дерево, TreeView или в ListBox?


 
Skyle   (2002-11-14 06:30) [3]


procedure BuildTree(Path : String);
var S : TSearchRec;
begin
if FindFirst(Path + "*.*, faDirectory, S) = 0 then
begin
if S.Name <> "." AND S.Name <> ".." then
begin
Засунуть_имя_папки_(S.Name)_куда_надо
BuiltTree(Path + S.Name); //Чтобы собрать её подпапки
end;
while FindNext(S) = 0 do
begin
if S.Name <> "." AND S.Name <> ".." then
begin
Засунуть_имя_папки_(S.Name)_куда_надо
BuiltTree(Path + S.Name); //Чтобы собрать её подпапки
end;
end;
end;
FindClose(S);
end;


Не проверял, но вроде должно работать. Сразу сорри за возможные косяки...:)))))


 
Separator   (2002-11-14 06:56) [4]


function GetDirs(Dir: string; Nodes: TTreeNodes): boolean;
procedure FindDirs(Path: string; Node: TTreeNode);
var
lpFindFileData: _WIN32_FIND_DATAA;
hFindFile: Cardinal;

begin
hFindFile:= Windows.FindFirstFile(PChar(Path + "*.*"), lpFindFileData);
if Windows.GetLastError <> INVALID_HANDLE_VALUE then
repeat
if ((lpFindFileData.dwFileAttributes and $00000010) = $00000010) and (lpFindFileData.cFileName[0] <> ".") then
FindDirs(Path + lpFindFileData.cFileName + "\", Node.Owner.AddChild(Node, lpFindFileData.cFileName))
until not Windows.FindNextFile(hFindFile, lpFindFileData);
Windows.FindClose(hFindFile)
end;

begin
if Dir[Length(Dir)] <> "\" then
Dir:= Dir + "\";
if not DirectoryExists(Dir) then
begin
Result:= false;
exit
end;
FindDirs(Dir, Nodes.AddChildFirst(nil, Copy(Dir, 1, Length(Dir) - 1)));
Result:= true
end;

Например:

procedure TForm1.Button1Click(Sender: TObject);
begin
GetDirs(Edit1.Text, TreeView1.Items)
end;



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

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

Наверх





Память: 0.46 MB
Время: 0.013 c
7-83025
Данилин Руслан
2002-07-19 14:02
2002.11.25
Как отключить кнопку Пуск


3-82592
diMANISHE
2002-11-04 16:42
2002.11.25
Правильно или нет?


1-82851
Zn
2002-11-14 10:31
2002.11.25
Выделение и освобождение памяти под PChar


1-82691
TTCustomDelphiMaster
2002-11-13 16:57
2002.11.25
ActiveX.2


1-82775
Оля
2002-11-15 17:08
2002.11.25
*.WAV наткнулась на один пример, но он у меня не работает





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский