|
|
Регистрация | << Правила форума >> | 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; Писал по памяти, мог ошибиться где-нить... THE CRACKER IS OUT THERE |