Поиск файлов в папках и подпапках

[Format C:]

Вообщем проблема следующая:
Есть папка. В этой папке находатся ещё три подпапки. Нужно найти все файлы, удоволетворяющие условиям поиска, в папке, а потом во всех подпапках, с теми же условиями.

Вот что у меня получилось:

Procedure TMainForm.AddFolderToPlayList(Dir: String; Format: String; Folder: Boolean);
Var
  Folders: TStrings;// Memo на форме
  I, M: Integer;
  SearchRec: TSearchRec;
Begin
  M:=-1;
  If FindFirst(Dir + Format, faAnyFile, SearchRec) = 0 Then
  Begin
    PlayListBox.Items.Add(Dir+SearchRec.Name);
    While (FindNext(SearchRec) = 0) Do
      PlayListBox.Items.Add(Dir+SearchRec.Name);
  End;
  FindClose(SearchRec);

  If Folder Then
  Begin
    If FindFirst(Dir+'*', faDirectory, SearchRec) = 0 Then
    Begin
      If (SearchRec.Name<>'') And (SearchRec.Name<>'.') And (SearchRec.Name<>'..') Then
      Begin
        M:=M+1;
        Folders.Add(Dir+SearchRec.Name+'\');
      End;

      While (FindNext(SearchRec) = 0) Do
        If (SearchRec.Name<>'') And (SearchRec.Name<>'.') And (SearchRec.Name<>'..') Then
        Begin
          M:=M+1;
          Folders.Add(Dir+SearchRec.Name+'\');
        End;
      FindClose(SearchRec);

      For I:=0 To M Do AddFolderToPlayList(Folders.Strings[I], Format, True);
    End;
  End;
End;

Но это работать не хочет. Точнее добавляет файлы только из первой папки. А дальше либо ничего не находит, либо зацикливается и вылетает.

Что в процедуре не так?

[Alar]

Довольно простой пример. Хочеться дать только вот эту ссылку.

http://www.programmersclub.ru/labmultimedta

Mp3-плеер

Программа для воспроизведения mp3 файлов. Для запуска программы поместите в каталог с Delphi исходником mp3 файлы и только после этого запускайте проект.
Скачать (15 кб)

[Format C:]

Я наверное не так объяснил. Я умею искать в папке. Мне нужно организовать поиск в под папках. Т.е. есть папка : H:\Music. В ней лежат папки Album1, Album2, Album3. От процедуры требуется:
1. Найти все файлы по указаному пути
2. Просканировать папку на наличие других папок
3. Запустить поиск в каждой найденной папке

1 пункт готов. Заговоздка с двумя остальными. Я уже и масив пробовал, и Memo и TStrings. Толку никакого.

В алгоритме организованна попытка рекрусии, но как-то не особо работает. Если кто знает ещё вариант решения, не откажусь его выслушать.

[Alar]

С папками работаешь как и сдругими файлами. маску поиска посмотри.

Никаких рекурсий не надо.

как я реализовываю
1) процедура поиска файлов.

2) передаёшь процедуре маску, получаешь массив с файлами (папки ищет также как файлы).

3) для перехода в папку используешь http://www.delphibasics.ru/ChDir.php

для возврата ChDir('..');

'..' - это должен знать ещё из доса.

Если я тебе дам код, то тебе же будет не интересно

[Format C:]

Огромное спасибо тебе за ссылку, поиск работает лучше, но не всё сканирует. Вот что у меня получилось:

Procedure TMainForm.AddFolderToPlayList(Dir: String; Format: String; Folder: Boolean);

Procedure Find(Dir: String; Format: String);
Var
  SearchRec: TSearchRec;
Begin
  If FindFirst(Dir + Format, faAnyFile, SearchRec) = 0 Then
  Begin
    PlayListBox.Items.Add(Dir+SearchRec.Name);
    While (FindNext(SearchRec) = 0) Do
      PlayListBox.Items.Add(Dir+SearchRec.Name);
  End;
  FindClose(SearchRec);
End;

Var
  SearchRec: TSearchRec;
  NextDir: String;
Begin
  Find(Dir, Format);

  If Folder Then
  Begin
    If FindFirst(Dir+'*', faDirectory, SearchRec) = 0 Then
    Begin
      If (SearchRec.Name<>'') And (SearchRec.Name<>'.') And (SearchRec.Name<>'..') Then
      Begin
        ChDir('..'); // Есть смысл от этой строчки?
        ChDir(Dir+SearchRec.Name);
        GetDir(0, NextDir);
        Find(NextDir+'\', Format);
      End;

      While (FindNext(SearchRec) = 0) Do
        If (SearchRec.Name<>'') And (SearchRec.Name<>'.') And (SearchRec.Name<>'..') Then
        Begin
          ChDir('..'); // Есть смысл от этой строчки?
          ChDir(Dir+SearchRec.Name);
          GetDir(0, NextDir);
          Find(NextDir+'\', Format);
        End;

      FindClose(SearchRec);
    End;
  End;
End;

Я не пойму, как его заставить искать в папках которые лежат "глубже" 1 уровня (0 - задайтся переменной Dir, 1 - "глубже" Dir на одну папку, 2 - "глубже" на две и т.д.)

И ещё: Иногда вылезает ошибка I\O error 267

[Alar]

ChDir('..'); - используют для возврата из папки назад.

[Format C:]

Ничего не получилось. Добился тока вылета постоянной ошибки "File not found".
Дай, пожалуйста, код, чтобы я посмотрел и сделал по аналогии.

[mrandrey]

Вот можеш пользоваться, а можешь глянуть как я это сделал:

 { Public declarations }
 sc:TScan;
 procedure onscan(path:string;Dan:TSearchRec;f:boolean);
....
procedure TForm1.FormCreate(Sender: TObject);
begin
sc:=TScan.Create;
sc.Path:='Путь';
sc.Mask:='*.exe;*.txt';
sc.RescueDir:=true;//сканировать вложенные папки
sc.FirstDir:=true;//сначала ищутся папки
sc.ShowFile:=true;//находить файлы
sc.OnFound:=onscan;
sc.Scan:=true;//начать поиск, в любой момент изменяешь на ложь и поиск прекращается
sc.Destroy;
end;
 
procedure TForm1.onscan(path: string; Dan: TSearchRec; f: boolean);
begin
path-путь
f-файл или нет
dan - инфа о файле
end;
 
а вот и самое главное:
 
unit Scan;
interface
uses SysUtils,str,Dialogs;
const
  faOnlyFile  = $1 or $2 or $4 or $8 or $20;
  
Type
procStringSearcrecBool = procedure(path:string;
DN:tsearchrec;Fil:boolean) of object;
searchrec=tsearchrec;
TScan = class
private
    FScan,fd,frd,sf:boolean;
    FPath: string;
    Ffound: procStringSearcrecBool;
    FMask: string;
procedure SetScan(const Value: boolean);
procedure SSS(ph:string);
procedure SetMask(const Value: string);
procedure Setpath(const Value: string);
public
property Path:string read FPath write setPath;
property Mask:string read FMask write SetMask;
property Scan:boolean read FScan write SetScan;
property RescueDir:boolean read Frd write frd;
property FirstDir:boolean read fd write fd;
property ShowFile:boolean read sf write sf;
property OnFound:procStringSearcrecbool read Ffound write Ffound;
constructor Create;
destructor Destroy; override;
end;

implementation
{ TScan }
constructor TScan.Create;
begin inherited;
mask:='*.*';sf:=true;end;
destructor TScan.Destroy;
begin inherited;end;

procedure TScan.SetMask(const Value: string);
begin if FScan then exit;
FMask := Value;
if Str_EndPos(FMask)<>';'then
FMask:=FMask+';';
if(FMask=';')or(pos('*.*',fmask)>0)then FMask:='*.*;';end;
procedure TScan.Setpath(const Value: string);
begin FPath:=Str_Replacement(value+'\','\\','\');end;
procedure TScan.SetScan(const Value: boolean);
begin FScan := Value;
if value then sss(path);
fScan:=false;
end;
procedure TScan.SSS;
var r:tsearchrec;m:string;
function delm:string;{Следующая маска}
begin result:=Str_CopyToFirst(m,';');
if result=''then exit;
m:=Str_DelToFirst(m,';');
delete(m,1,1);end;{Delm}
procedure sfile(pah:string);{Поиск файлов}
var mm:string;
Begin if not sf then exit;
m:=mask;mm:=delm;
while(mm<>'')and(FScan)do begin
if FindFirst(ph+mm,FAonlyfile,r)=0then
repeat if Assigned(ffound)then
ffound(pah,r,true);
until(FindNext(r)<>0)or not FScan;
mm:=delm;end;End;{sfile}
procedure sdir(pah:string);{Поиск дирректорий}
const pp=faanyfile;
var d:string;
Begin if FindFirst(pah+'*.*',pp,r)=0then
repeat if not FScan then exit;
if((r.Attr and fadirectory)<>0)
and(r.Name<>'.')and(r.Name<>'..')then begin
if Assigned(ffound)then Ffound(pah,r,false);
if RescueDir then sss(pah+r.Name);end;
until (FindNext(r)<>0);End;{sdir}
begin if not FScan then exit;
if Str_EndPos(ph)<>'\'then
ph:=ph+'\';
if fd then sdir(ph);
sfile(Ph);
if not fd then sdir(ph);
FindClose(r);
end;
end.

[dron-s]

попробйу вот так

procedure ScanDir(StartDir: string; Mask: string; List: TStrings);
var
  SearchRec: TSearchRec;
begin
  if Mask = '' then
    Mask := '*.*';
  if StartDir[Length(StartDir)] <> '\' then
    StartDir := StartDir + '\';
  if FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
  begin
    repeat Application.ProcessMessages;
      if (SearchRec.Attr and faDirectory) <> faDirectory then
        List.Add(StartDir + SearchRec.Name)
      else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.')thenbegin
        List.Add(StartDir + SearchRec.Name + '\');
      ScanDir(StartDir + SearchRec.Name + '\', Mask, List);
  end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;

[Format C:]

Спасибо, что откликнулись

2mrandrey:

Код сложный, поэтому разбираться в нём буду на выходных.
Как я понял, это модуль.
И тут без 100 грамм точно не разберёшся

2dron-s:

Этот код у меня не заработал, но суть ясна. Буду копать в этом направлении. Мож к концу недели сделаю.

P.S. А для чего нужен List: TStrings ? Не проще сразу добавлять в нужное место.
Ещё мне не понятна эта строка:

if (SearchRec.Attr and faDirectory) <> faDirectory then

(Я догадываюсь, что она служит для определения файл это или папка)