![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
|
|
#1
|
||||
|
||||
|
Hi people!
каоче у меня такая беда: моя прога считает файлы в какой либо папке а мне нужно что бы считала во вложенный директориях вот сам код : Function GetFileCount(Dir, ext:string):integer; var fs:TSearchRec; begin Result:=0; if FindFirst(Dir+'\*.'+ext,faAnyFile-faDirectory-faVolumeID, fs)=0 then repeat inc(Result); until FindNext(fs)<>0; FindClose(fs); end; procedure TForm1.Button1Click(Sender: TObject); begin Form1.Caption:=IntToStr(GetFileCount(Edit1.Text, Edit2.Text)); end; заранее спасибо |
|
#2
|
||||
|
||||
|
Вызывай функцию подсчета для каталогов рекурсивно.
|
|
#3
|
|||
|
|||
|
На держи, вырезал у себя с учебника, тут как раз рекурсия(Вызов функцией саму себя).
Листинг 12.3. Программа поиск файлов // поиск файла в указанном каталоге и его подкаталогах // используется рекурсивная процедура Find unit FindFile_; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtr; type TForm1 = class(TForm) Editl: TEdit; // что искать Edit2: TEdit; // где искать Memo1: TMemo; // результат поиска Button1: TButton; // кнопка Поиск Button2: TButton; // кнопка Папка Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var FileName: string; // имя или маска искомого файла cDir: string; n: integer; // кол-во файлов, удовлетворяющих запросу // поиск файла в текущем каталоге procedure Find; var SearchRec: TSearchRec; // информация о файле или каталоге begin GetDir(0,cDir); // получить имя текущего каталога if cDir [length (cDir) ] <> 'V then cDir := cDir+'\'; if FindFirst(FileName, faArchive,SearchRec) = 0 then repeat if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then begin Form1.Memo1.Lines.Add(cDir + SearchRec.Name); n := n + 1; end; until FindNext(SearchRec) <> 0; // обработка подкаталогов текущего каталога if FindFirst('*', faDirectory, SearchRec) = 0 then repeat if (SearchRec.Attr and faDirectory) = SearchRec.Attr then begin // каталоги .. и . тоже каталоги, // но в них входить не надо .'.'.' if SearchRec.Name[1] <> '.' then begin ChDir(SearchRec.Name);// войти в каталог Find; // выполнить поиск в подкаталоге ChDir('..');// выйти из каталога end; end; until FindNext(SearchRec) <> 0; end; / возвращает каталог, выбранный пользователем function GetPath(mes: string):string; var Root: string; // корневой каталог pwRoot : PWideChar; Dir: string; begin Root := ''; GetMem(pwRoot, (Length(Root)+1) * 2); pwRoot := StringToWideChar(Root, pwRoot, MAX_PATH*2); if SelectDirectory(mes, pwRoot, Dir) then if length(Dir) =2 // пользователь выбрал корневой каталог then GetPath := Dir+'\' else GetPath := Dir else GetPath := ''; end; щелчок на кнопке Поиск procedure TForml.ButtonlClick(Sender: TObject); begin Memo1.Clear; // очистить поле Memol Label4.Caption := ''; FileName := Edit1.Text; // что искать. cDir := Edit2.Text; // где искать n:=0; // кол-во найденных файлов ChDir(cDir); // войти в каталог начала поиска Find; // начать поиск if n = 0 then ShowMessage('Файлов, удовлетворяющих критерию поиска нет.') else Label4.Caption := 'Найдено файлов:' + IntToStr(n); end; // щелчок на кнопке Папка procedure TForml.Button2Click (Sender: TObject); var Path: string; begin Path := GetPath('Выберите папку'); if Path <> '' then Edit2.Text := Path; end; end. |
|
#4
|
||||
|
||||
|
sMask - маска для поиска, например, *.* или *.mp3 или somefile.ext
sDirPath - путь до папки, в которой будет происходить поиск iFilesCount - возвращаемая переменная с количеством найденных файлов если это не нужно, можнр легко исключитьь из ф-ии saFound - возвращаемый массив с путями до найденных файлов bRecurse - искать ли в подпапках Код:
function FilesInDir(sMask, sDirPath: String; var iFilesCount: Integer; var saFound: TStrings; bRecurse: Boolean = True): Integer;
var
sr: TSearchRec;
begin
try
if FindFirst(sDirPath + sMask, faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = 0) then
begin
Inc(iFilesCount);
if saFound <> nil then
begin
if saFound.IndexOf(sDirPath + sr.Name) < 0 then
saFound.Add(sDirPath + sr.Name);
end;
end
else
begin
if (sr.Name <> '.') and (sr.Name <> '..') and (bRecurse) then
FilesInDir(sMask,sDirPath + sr.name + '\',iFilesCount,saFound,bRecurse);
end;
until
FindNext(sr) <> 0;
end;
FindClose(sr);
except
Result := -1;
end;
end;
Пример использования: Код:
//...
var
iCount: Integer;
sImagesPath: String;
saImages: TStrings;
begin
sImagesPath := 'c:\папка\';
saImages := TImagesList.Create();
FilesInDir('.jpg',sImagesPath,iCount,saImages,True);
// у нас в saImages список всех файлов с разширением .jpg,
// находящихся в папке c:\папка
saImages.Free;
end;Писал по памяти, мог ошибиться где-нить... |