Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Имена, пути файлов



Вернуться к списку функций
 Получение списка вложенных каталогов

 Прислал: Samsonov Aleksandr (Tver) ( 19 сентября 2002 г. )
©  s002156Shurik
 Описание:
Процедура служит ля получения списка каталогов вложенных в указанный каталог.
Полезно ее использовать для построения дерева каталогов.
Полученные в OutPaper данные можно передать процедуре Радионова Алексейя которая по ним построит дерево.

 Зависимости:
sysutils, classes, StdCtrls, UDBF.FillTreeViewWithFiles

 Ограничения:
W98 D6

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Получение списка вложенных каталогов

Процедура служит ля получения списка каталогов вложенных в указанный каталог.
Полезно ее использовать для построения дерева каталогов.
Полученные в OutPaper данные можно передать процедуре Радионова Алексейя которая по ним построит дерево.

Зависимости: sysutils, classes, StdCtrls, UDBF.FillTreeViewWithFiles
Автор:       Samsonov Aleksandr, s002156@mail.ru, Tver
Copyright:   s002156Shurik
Дата:        19 сентября 2002 г.
***************************************************************** }

procedure GetTreeDirs(Root:String;OutPaper:TStringList);
var
  i:Integer;
  s:String;

  procedure InsDirs(s:String;ind:Integer;Path:String;OPaper:TStringList);
  var {Вставляет в Memo список вложенных директорий}
    sr:TSearchRec;
    attr:Integer;
  begin
    attr:=0;
    attr:=faAnyFile;
    if DirectoryExists(Path)then
    if FindFirst(IncludeTrailingBackslash(Path)+'*.*',attr,SR) = 0 then
    begin
      repeat
        if(sr.Attr=faDirectory)and(sr.Name[Length(sr.Name)]<>'.')then
          OPaper.Insert(ind,s+sr.Name);
      until (FindNext(sr)<>0);
      FindClose(SR);
    end
  end;

begin
  {Проверяем существуетли начальный каталог}
  if not DirectoryExists(Root) then exit;
  {Создаем список каталогов первой вложенности}
  if root[Length(Root)]<>'\' then
     InsDirs(root+'\',OutPaper.Count,Root,OutPaper)
    else
     InsDirs(root,OutPaper.Count,Root,OutPaper);
  i:=0;
  repeat
    s:=OutPaper[i]; //в s получаем путь к уже внесенному в список кат.
    // Вставляем сразу за данной директорией в списке,
    // список вложенных в нее директорий.
    // Тем самым увеличиваем OutPaper.Lines.Count.
    // Таким образом катологи в которых поиск еще не производился,
    // оказываются ниже и очереь до них еще дойдет.
    InsDirs(s+'\',i+1,OutPaper[i],OutPaper);
    inc(i);
  until (i=OutPaper.Count);
end;

 Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
  Strs : TStringList;
begin
  Strs := TStringList.Create;
  try
    GetTreeDirs('C:\',Strs);
    FillTreeViewWithFiles(TreeView1,Strs);
  finally
    Strs.Free;
  end;
end;


Вернуться к списку функций

Наверх ▲