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

Вниз

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

← →
Дубинин Алексей   (2004-10-08 22:08) [0]

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


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.

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

С уважением,

---

← →
Alekc   (2004-10-08 22:44) [1]

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

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.

---

← →
Alekc   (2004-10-08 22:51) [2]

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


---

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

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

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

---

← →
Silla ©   (2004-10-10 00:42) [4]

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;

---

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

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

Наверх

Память: 0.49 MB
Время: 0.03 c