поиск файлов

← →
Тетрис2009 (2009-03-17 09:44) [0]

подскажите алгоритм поиска всех файлов в папках.
Есть папки и в каждой могут быть тоже папки.То есть 2 уровня.
В них JPEG и надо их посчитать (но посчитать те которые меньше 5 мегов весят, если он больше то это РАВ и его считать не надо)
возможна адаптпция алгоритма удаления всех файлов - там только
заменить удаление на проверку размера и подсчет

Пока набросал алгоритм на ВСЛ - считает количество всех JPG
в папках первого уровня. перебрать папки второго уровня не получается

← →
Тетрис2009 (2009-03-17 09:44) [1]

сообственно код

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl; type TForm1 = class(TForm) Button1: TButton; DriveComboBox1: TDriveComboBox; FileListBox1: TFileListBox; FOLDERS: TListBox; FileListBox2: TFileListBox; Edit1: TEdit; LIST: TListBox; SaveDialog1: TSaveDialog; Button2: TButton; procedure DriveComboBox1Change(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure FindFolder (Sender: TObject); procedure FindFolderLevel2(Sender: TObject); procedure CountJpg(Sender: TObject); end; var Form1: TForm1; ALL:dword; implementation {$R *.DFM} procedure TForm1.DriveComboBox1Change(Sender: TObject); begin FileListBox1.Drive:=DriveComboBox1.Drive; end; //---------------------------- function Spliter(s:string):string; begin Result:=copy(s,2,length(s)-2); end; //------------------------------- procedure TForm1.FindFolder(Sender: TObject); var a:dword; s:string; begin FOLDERS.Items.Clear; for a:=0 to FileListBox1.Items.Count-1 do begin s:=Spliter(FileListBox1.Items.Strings[a]); s:=Edit1.text+s; FOLDERS.Items.Add(s); end; end; //--------------------------------------- procedure TForm1.FindFolderLevel2(Sender: TObject); label e; var a,b,c:dword; s,m:string; begin a:=FOLDERS.Items.Count-1; for b:=0 to a do begin s:=FOLDERS.Items.Strings[b]; // Папка s:=Edit1.text+s; s:=DriveComboBox1.Drive+":\"+s; showmessage(s); FileListBox1.Directory:=s; FileListBox1.Update; showmessage(inttostr(FileListBox1.Items.Count)); if FileListBox1.Items.Count=-1 then goto e; for c:=0 to FileListBox1.Items.Count-1 do begin m:=Spliter(FileListBox1.Items.Strings[a]); FOLDERS.Items.Add(s+"\"+m); end; e: showmessage("1"); end; end; //--------------------------------------- procedure TForm1.CountJpg(Sender: TObject); var a:dword; s,x:string; begin for a:=0 to FOLDERS.Items.Count-1 do begin x:=FOLDERS.Items.Strings[a]; s:=DriveComboBox1.Drive+":\"+Edit1.text+x; FileListBox2.Directory:=s; FileListBox2.Update; ALL:=ALL+FileListBox2.Items.Count; LIST.Items.Add(x+ " ="+inttostr(FileListBox2.Items.Count)); end; end; //--------------------------------------- procedure TForm1.Button1Click(Sender: TObject); begin ALL:=0; FindFolder(Self); //FindFolderLevel2(Self); CountJpg(Self); LIST.Items.Add(""); LIST.Items.Add(inttostr(ALL)); end; //------------------- procedure TForm1.Button2Click(Sender: TObject); begin if SaveDialog1.Execute=true then begin LIST.Items.SaveToFile(SaveDialog1.FileName+".txt"); end; end; end.

← →
Ega23 © (2009-03-17 09:57) [2]

FindFirst + FindNext + f1

← →
немо2 (2009-03-17 10:03) [3]

а поискать сначала?
первые же строки в поисковике

файлы в каталоге
procedure ListFileDir(Path: string; FileList: TStrings);
var
SR: TSearchRec;
begin
if FindFirst(Path + "*.*", faAnyFile, SR) = 0 then
begin
repeat
if (SR.Attr <> faDirectory) then
begin
FileList.Add(SR.Name);
end;
until FindNext(SR) <> 0;
FindClose(SR);
end;
end;

======================
каталоги в каталоге

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;

> немо2 (17.03.09 10:03) [3]

Олег в [2] уже сказал где искать. В справке по этим функциям есть пример, в котором всё делается через рекурсию и делается несколько компактнее.

поиск файлов Найти похожие ветки