Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > ОС и железо
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 29.06.2007, 16:00
Аватар для Sharky
Sharky Sharky вне форума
Активный
 
Регистрация: 20.03.2007
Сообщения: 202
Репутация: 10
Сообщение Помогите пожалуйста доделать прогу

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  
Старый 02.07.2007, 09:09
Аватар для Aristarh Dark
Aristarh Dark Aristarh Dark вне форума
Модератор
 
Регистрация: 07.10.2005
Адрес: Москва
Сообщения: 2,906
Версия Delphi: Delphi XE
Репутация: выкл
По умолчанию

Вызывай функцию подсчета для каталогов рекурсивно.
Ответить с цитированием
  #3  
Старый 08.07.2007, 14:37
francyz francyz вне форума
Прохожий
 
Регистрация: 08.07.2007
Сообщения: 2
Репутация: 10
По умолчанию

На держи, вырезал у себя с учебника, тут как раз рекурсия(Вызов функцией саму себя).
Листинг 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  
Старый 08.07.2007, 15:15
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

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
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 04:33.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter