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

[dron-s]

это строка как раз таки и просматривает текущие директории
List:TString - в эту переменную записывается список всех файлов...
почему у тебя код не заработал? какие ошибки выдал?

[Format C:]

Ошибка следующая:
=========
Access violation at adress 00414591 in module "Player.exe". Read of asress 0000BD25.
=========
Ошибка выскакивает сразу же.

Код который вызывает процедуру:

procedure TAddForm.AddButClick(Sender: TObject);
Var
  pwRoot: PWideChar;
  Dir: String;
  PlayList: TStrings;
begin
  GetMem(pwRoot, (Length(Root)+1)*2);
  pwRoot:=StringToWideChar(Root, pwRoot, MAX_PATH*2);
  If not SelectDirectory('Выберите папку в которой находятся файлы', pwRoot, Dir) Then
  Dir:=''
  Else Dir:=Dir+'\';
  MainForm.ScanDir(Dir, '*.mp3', PlayList);
  MainForm.PlayListBox.Items.AddStrings(PlayList);
  Close;
end;

Может быть в нём ошибка.

И ещё:

if StartDir[Length(StartDir)-1] <> '\' then

Разве еденица не должна отниматся?

[Viteef]

Вот юзес с коментариями:

unit Search;
interface
uses Windows, Classes;
function SearchInFolder(folder, mask: String; flags: DWORD;
                        names: TStrings; addpath: Boolean = False): Boolean;
function SearchInTree(folder, mask: String; flags: DWORD;
                      names: TStrings; addpath: Boolean = False): Boolean;
implementation
//Функция возвращает True, если атрибуты (attrs) файла или папки
//соответствуют режиму поиска (flags)
//Реализует нестрогую проверку (принимаются файлы и каталоги, имеющие
//искомые атрибуты, независимо от наличия у них других дополнительных
//атрибутов, которые не заданы при поиске).
//Для реализации строгой проверки можно изменить
//MatchAttrs := (flags and attrs) = flags; на
//MatchAttrs := (flags = attrs);
function MatchAttrs(flags, attrs: DWORD): Boolean;
begin
  MatchAttrs := (flags and attrs) = flags;
end;
//Поиск по маске и атрибутам в заданной папке (если найден хоть один файл
//или каталог, то возвращается True).
//Список names заполняется именами найденных файлов и папок
function SearchInFolder(folder, mask: String; flags: DWORD;
                        names: TStrings; addpath: Boolean = False): Boolean;
var
  hSearch: THandle;
  FindData: WIN32_FIND_DATA;
  strSearchPath: String;
  bRes: Boolean; //Если равен True, то нашли хотя бы один файл или каталог
begin
  strSearchPath := folder + '\' + mask;
  bRes := False;
  //Начинаем поиск
  hSearch := FindFirstFile(PAnsiChar(strSearchPath), FindData);
  if (hSearch <> INVALID_HANDLE_VALUE) then
  begin
    //Ищем все похожие элементы (информация о первом элементе уже
    //записана в FindData функцией FindFirstFile)
    repeat
      if (String(FindData.cFileName) <> '..') and
         (String(FindData.cFileName) <> '.') then //Пропускаем . и ..
      begin
        if MatchAttrs(flags, FindData.dwFileAttributes) then
        begin
          //Нашли подходящий объект
          if addpath then
            names.Add(folder + '\' + FindData.cFileName)
          else
            names.Add(FindData.cFileName);
          bRes := True;
        end;
      end;
    until FindNextFile(hSearch, FindData) = FALSE;
    //Заканчиваем поиск
    FindClose(hSearch);
  end;
  SearchInFolder := bRes;
end;

//Функция поиска в дереве каталогов с заданным корневым каталогом (folder)
//В список записываются полные пути найденных файлов и папок
function SearchInTree(folder, mask: String; flags: DWORD;
                      names: TStrings; addpath: Boolean = False): Boolean;
var
  hSearch: THandle;
  FindData: WIN32_FIND_DATA;
  bRes: Boolean; //Если равен True, то нашли хотя бы один файл или каталог
begin
  //Осуществляем поиск в текущей папке
  bRes := SearchInFolder(folder, mask, flags, names, addpath);
  //Продолжим поиск в каждом из подкаталогов
  hSearch := FindFirstFile(PAnsiChar(folder + '\*'), FindData);
  if (hSearch <> INVALID_HANDLE_VALUE) then
  begin
    repeat
      if (String(FindData.cFileName) <> '..') and
         (String(FindData.cFileName) <> '.') then //Пропускаем . и ..
      begin
        if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0)
        then
          //Нашли подкаталог - выполним в нем поиск
          if SearchInTree(folder + '\' + String(FindData.cFileName),
                          mask, flags, names, addpath)
          then
            bRes := True;
      end;
    until FindNextFile(hSearch, FindData) = FALSE;
    FindClose(hSearch);
  end;
  SearchInTree := bRes;
end;
end.

[Viteef]

unit Search;
interface
uses Windows, Classes;
function SearchInFolder(folder, mask: String; flags: DWORD;
                        names: TStrings; addpath: Boolean = False): Boolean;
function SearchInTree(folder, mask: String; flags: DWORD;
                      names: TStrings; addpath: Boolean = False): Boolean;
implementation
//Функция возвращает True, если атрибуты (attrs) файла или папки
//соответствуют режиму поиска (flags)
//Реализует нестрогую проверку (принимаются файлы и каталоги, имеющие
//искомые атрибуты, независимо от наличия у них других дополнительных
//атрибутов, которые не заданы при поиске).
//Для реализации строгой проверки можно изменить
//MatchAttrs := (flags and attrs) = flags; на
//MatchAttrs := (flags = attrs);
function MatchAttrs(flags, attrs: DWORD): Boolean;
begin
  MatchAttrs := (flags and attrs) = flags;
end;
//Поиск по маске и атрибутам в заданной папке (если найден хоть один файл
//или каталог, то возвращается True).
//Список names заполняется именами найденных файлов и папок
function SearchInFolder(folder, mask: String; flags: DWORD;
                        names: TStrings; addpath: Boolean = False): Boolean;
var
  hSearch: THandle;
  FindData: WIN32_FIND_DATA;
  strSearchPath: String;
  bRes: Boolean; //Если равен True, то нашли хотя бы один файл или каталог
begin
  strSearchPath := folder + '\' + mask;
  bRes := False;
  //Начинаем поиск
  hSearch := FindFirstFile(PAnsiChar(strSearchPath), FindData);
  if (hSearch <> INVALID_HANDLE_VALUE) then
  begin
    //Ищем все похожие элементы (информация о первом элементе уже
    //записана в FindData функцией FindFirstFile)
    repeat
      if (String(FindData.cFileName) <> '..') and
         (String(FindData.cFileName) <> '.') then //Пропускаем . и ..
      begin
        if MatchAttrs(flags, FindData.dwFileAttributes) then
        begin
          //Нашли подходящий объект
          if addpath then
            names.Add(folder + '\' + FindData.cFileName)
          else
            names.Add(FindData.cFileName);
          bRes := True;
        end;
      end;
    until FindNextFile(hSearch, FindData) = FALSE;
    //Заканчиваем поиск
    FindClose(hSearch);
  end;
  SearchInFolder := bRes;
end;

//Функция поиска в дереве каталогов с заданным корневым каталогом (folder)
//В список записываются полные пути найденных файлов и папок
function SearchInTree(folder, mask: String; flags: DWORD;
                      names: TStrings; addpath: Boolean = False): Boolean;
var
  hSearch: THandle;
  FindData: WIN32_FIND_DATA;
  bRes: Boolean; //Если равен True, то нашли хотя бы один файл или каталог
begin
  //Осуществляем поиск в текущей папке
  bRes := SearchInFolder(folder, mask, flags, names, addpath);
  //Продолжим поиск в каждом из подкаталогов
  hSearch := FindFirstFile(PAnsiChar(folder + '\*'), FindData);
  if (hSearch <> INVALID_HANDLE_VALUE) then
  begin
    repeat
      if (String(FindData.cFileName) <> '..') and
         (String(FindData.cFileName) <> '.') then //Пропускаем . и ..
      begin
        if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0)
        then
          //Нашли подкаталог - выполним в нем поиск
          if SearchInTree(folder + '\' + String(FindData.cFileName),
                          mask, flags, names, addpath)
          then
            bRes := True;
      end;
    until FindNextFile(hSearch, FindData) = FALSE;
    FindClose(hSearch);
  end;
  SearchInTree := bRes;
end;
end.

 
Там две функции, одна ищет на одном уровне
 
function SearchInFolder(folder, mask: String; flags: DWORD;
                        names: TStrings; addpath: Boolean = False): Boolean;

другая - по всему дереву каталогов ниже:

 
function SearchInTree(folder, mask: String; flags: DWORD;
                      names: TStrings; addpath: Boolean = False): Boolean;

[Alar]

вынул из программы.


Поиск папок, заметь там есть фильтры на отсечение некоторых папок.
Вызови процедуру. poiskpapki;
и получишь, все папки в этом массиве - Directory, не забудь его сделать глобальным и переменную pap тоже.

procedure poiskpapki;
label a;
var
SearchRec: TSearchRec;
begin
 pap:=-1;
if FindFirst('*', faAnyFile, SearchRec) = 0 then
          repeat
              if (SearchRec.Attr and faDirectory) = faDirectory then
                    // каталоги .. и . тоже каталоги,
                    // но в них входить не надо !!!
                    if SearchRec.Name[1] <> '.' then
                       begin
                        if (SearchRec.Name='temp')or(SearchRec.Name='content')
                        or(SearchRec.Name='Thumbs.db')or(SearchRec.Name='index.html')
                         or(SearchRec.Name='text.txt')or(SearchRec.Name='key.txt')
                         then goto a;
                         pap:=pap+1;
                         setlength(directory,pap+1);
                         Directory[pap]:=SearchRec.Name;
                      a:
                       end;
          until FindNext(SearchRec) <> 0;

end;

А это файлы ищет. тоже есть фильры принцип действия такой же.

Вынцл код из программи, потому возможно, потребуеться его адаптировать под твою программу.

 procedure poiskpapki3;
label r;
var
SearchRec: TSearchRec;
begin

 pap3:=-1;
if FindFirst('*.*', faAnyFile, SearchRec) = 0 then
          repeat
                       if SearchRec.Name[1] <> '.' then
                       begin
                        if (SearchRec.Name='temp')or(SearchRec.Name='content')
                        or(SearchRec.Name='Thumbs.db')or(SearchRec.Name='index.html')
                        then goto r;
                         pap3:=pap3+1;
                         setlength(directory3,pap3+1);
                         Directory3[pap3]:=SearchRec.Name;
                      r:
                       end;
          until FindNext(SearchRec) <> 0;

Пример использования -

  
poiskpapki;
for i:=0 to pap do
begin
ChDir( directory[i]);
memo3.Lines.SaveToFile(directory[i]+inttostr(chislo_stranic)+'.php');
    ChDir('..');

end;

[dron-s]

format c
а что отладчик показывает? в каком месте косяк?
попробуй вот так вот использовать процедуру

  ListBox1.Items.Clear;
  ScanDir('c:', '', ListBox1.Items);
  Label1.Caption := IntToStr(ListBox1.Items.Count);

по крайней мере у меня работает

[Format C:]

2dron-s:
Отладчик ничего не показывает, т.к. ошибки не возникает, но файлы в подпапках не ищет. Ищет только файлы в самой папке.

Оценив выше сказанную информацию сварганил новую прцедуру. Но она всё равно не работает

Выдаёт ошибку:
=========
I/O error 267
=========

Процедура:

Procedure TMainForm.AddFolderToPlayList(Format: String; Folder: Boolean);
Var
  SearchRec: TSearchRec;
begin
  If FindFirst(Format, faAnyFile, SearchRec) = 0 Then
    PlayListBox.Items.Add(SearchRec.Name);
  While FindNext(SearchRec) = 0 Do
    PlayListBox.Items.Add(SearchRec.Name);
  FindClose(SearchRec);

  If Folder Then
  Begin
  If FindFirst('*', faDirectory, SearchRec) = 0 Then
    If (SearchRec.Name<>'') And (SearchRec.Name<>'.') And (SearchRec.Name<>'..') Then
    Begin
      ChDir(SearchRec.Name+'\');
      AddFolderToPlayList(Format, True);
      ChDir('..');
    End;

    While FindNext(SearchRec) = 0 Do
    Begin
      ChDir(SearchRec.Name+'\');
      AddFolderToPlayList(Format, True);
      ChDir('..');
    End;
  FindClose(SearchRec);
  End;
End;

Вызов:

Var
  pwRoot: PWideChar;
  Dir: String;
begin
  GetMem(pwRoot, (Length(Root)+1)*2);
  pwRoot:=StringToWideChar(Root, pwRoot, MAX_PATH*2);
  If not SelectDirectory('Выберите папку в которой находятся файлы', pwRoot, Dir) Then
  Dir:=''
  Else Dir:=Dir+'\';
  ChDir(Dir);
  MainForm.ScanDir(Dir, '*.mp3', PlayList.Items); //PlayList это ListBox на форме
End;

Объясните подробно, по шагам, какой нужен алгоритм, и почему этот не работает

Если надо, могу прислать полный код программы.

[BOBAH13]

я конечно толком не разобрался но меня пугает немного две вещи
1. Dir:=''
Else Dir:=Dir+'\'; Вроде селектдира вернет со слешем (возможно ошибаюсь)
2. ChDir(Dir) - незнаю, были у меня с ним проблемы не подружились, больше доверяю Апи Windows.SetCurrentDirectory

а так по коду вроде все хокей, да и чего там такого сложного в поиске то вот код для удаления всех подпапок и фалов в них указаной папки смотрите

procedure DeleteFiles(Dira:String);
var
  rc:tsearchrec;
begin
  if dira[length(dira)] <> '\' then
    dira := dira + '\';
  if findfirst(dira+'*',faanyfile,rc) = 0 then
  repeat
    if rc.Attr and fadirectory = 0 then
    begin
      deletefile(dira+rc.Name);
    end
      else
    if pos('.',rc.Name) = 0 then
    begin
      DeleteFiles(dira+rc.Name);
    end;
  until
    findnext(rc) <> 0;
  findclose(rc);
  removedir(dira);
end;

собсно рекурсия ))) а так не получится надо отдельную процедуру писать