| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Поиск всех каталогов по выбранной маске, Рекурсия. [D6, WinXP]

Дубинин Алексей ©   (2004-10-08 22:08:00) 

Уважаемые программисты. Я несколько дней "сканировал" сборник форумов этого сайта. Искал как выполнить рекурсию поиска файлов. Столкнулся с тем, что никто так и не привел примера рекурсии, хотя все писали вызов процедуры самой себя. Я делал с самого начала все так же как и было написано Вами же на этих форумах. Только я так и не нашел (наверное плохо искал) как все таки найти все каталоги, например начиная с пути поиска С:\
По тому что писали вы получается найти первый каталог, его поддиректорию, если она есть и т.д. НО не более дальше просто все заканчивается. Может я чего то недопонимаю.
Для всего этого высылаю свой отрывок кода.


unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Menus, StdCtrls;
type
 TForm1 = class(TForm)
   Button1: TButton;
   pm: TPopupMenu;
   procedure Button1Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 public
   procedure SearchDir(mnu: TMenuItem; path: String);
 end;
var
 Form1: TForm1;
 sr: TSearchRec;
 path: String;
 mnuItem: TMenuItem;
 i: LongInt;
 mask: String;
implementation
uses FileCtrl;
{$R *.dfm}
procedure TForm1.SearchDir(mnu: TMenuItem; path: String);
begin
     if FindFirst(path+mask, faAnyFile, sr) = 0 then
       repeat
           if (sr.Attr and faDirectory <> 0) and (sr.Name[1]<>'.') then
           begin
             mnuItem:=TMenuItem.Create(self);
             mnuItem.Caption:=sr.Name+' ['+IntToStr(sr.Attr)+']';
             mnu.Add(mnuItem);
             path:=path+sr.Name+'\';
             SearchDir(mnuItem, path);
           end;
       until FindNext(sr) <> 0;
     FindClose(sr);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 mask:='*.*';
 path:='';
 if SelectDirectory('Выбор папки:', '', path) then
   begin
     if path[Length(path)] <> '\' then path:=path+'\';
     SearchDir(pm.Items, path);
   end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 mnuItem.Free;
end;
end.

Заранее спасибо всем откликнувшимся.

С уважением,

---

Silla   (2004-10-10 00:42:00) [1]

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;

---

Дубинин Алексей   (2004-10-09 21:41:00) [2]

Все равно ты только кое что более корректно написал а смысл остался прежним. Короче я что хочу сказать то... вот предположит простейшая структура папок:
[1]
|-->[11]-->[111]
|-->[12]
[2]

Думаю понятно. Так вот, этоим кодом можно получить только
[1]-->[11]-->[111]
а нужно то вернуться и получить [12]и опять вернуться и получить [2].
Кто нибудь помогите!!!

---

Alekc   (2004-10-08 22:51:00) [3]

Поправочка: SearchDir(Item, Path + SR.Name+'\', Mask);


---

Alekc   (2004-10-08 22:44:00) [4]

Вот так попробуй...

var
Form1: TForm1;

implementation

uses FileCtrl;

{$R *.dfm}

procedure TForm1.SearchDir(Menu: TMenuItem; Path, Mask: String);
var
 SR: TSearchRec;
 Item: TMenuItem;
begin
 If FindFirst(Path + Mask, faAnyFile, SR) = 0 then
 Repeat
   If (SR.Attr and faDirectory <> 0) and
    (SR.Name<>'.') and (SR.Name<>'..') then // '.foto' тоже правильное имя каталога...
   begin
     Item := TMenuItem.Create(Self);
     Item.Caption := SR.Name+' ['+IntToStr(SR.Attr)+']';
     Menu.Add(Item);
     SearchDir(Item, Path + SR.Name+'\');
   end;
 Until FindNext(SR) <> 0;
 FindClose(SR);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Path: String;
begin
 Path := '';
 If SelectDirectory('Выбор папки:', '', Path) then
 begin
   Path := IncludeTrailingPathDelimiter(Path);
   SearchDir(pm.Items, Path, '*.*');
 end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
// mnuItem.Free; -> зачем ? Форма автоматом освободит...
end;

end.

---

Наверх