Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц, летом дешевле!

Ответ
 
Опции темы Поиск в этой теме
Старый 03.05.2007, 15:39   #11
dron-s
Форумчанин
 
Регистрация: 04.03.2007
Сообщений: 615
По умолчанию

это строка как раз таки и просматривает текущие директории
List:TString - в эту переменную записывается список всех файлов...
почему у тебя код не заработал? какие ошибки выдал?
dron-s вне форума Ответить с цитированием
Старый 03.05.2007, 17:32   #12
Format C:
Пользователь
 
Регистрация: 11.03.2007
Сообщений: 92
По умолчанию

Ошибка следующая:
=========
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
Разве еденица не должна отниматся?
Format C: вне форума Ответить с цитированием
Старый 03.05.2007, 17:47   #13
Viteef
stopfake.org
Участник клуба
 
Регистрация: 03.05.2007
Сообщений: 1,927
Подмигивание

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

Код:
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 вне форума Ответить с цитированием
Старый 03.05.2007, 22:15   #14
Viteef
stopfake.org
Участник клуба
 
Регистрация: 03.05.2007
Сообщений: 1,927
По умолчанию

Код:
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;
Viteef вне форума Ответить с цитированием
Старый 03.05.2007, 22:53   #15
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 17,465
По умолчанию

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


Поиск папок, заметь там есть фильтры на отсечение некоторых папок.
Вызови процедуру. 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;
Alar вне форума Ответить с цитированием
Старый 03.05.2007, 23:11   #16
dron-s
Форумчанин
 
Регистрация: 04.03.2007
Сообщений: 615
По умолчанию

format c
а что отладчик показывает? в каком месте косяк?
попробуй вот так вот использовать процедуру
Код:
  ListBox1.Items.Clear;
  ScanDir('c:', '', ListBox1.Items);
  Label1.Caption := IntToStr(ListBox1.Items.Count);
по крайней мере у меня работает
dron-s вне форума Ответить с цитированием
Старый 04.05.2007, 22:06   #17
Format C:
Пользователь
 
Регистрация: 11.03.2007
Сообщений: 92
Вопрос

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;
Объясните подробно, по шагам, какой нужен алгоритм, и почему этот не работает

Если надо, могу прислать полный код программы.
Format C: вне форума Ответить с цитированием
Старый 04.05.2007, 23:31   #18
BOBAH13
Android Developer
Старожил Подтвердите свой е-майл
 
Аватар для BOBAH13
 
Регистрация: 19.02.2007
Сообщений: 3,708
По умолчанию

я конечно толком не разобрался но меня пугает немного две вещи
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;
собсно рекурсия ))) а так не получится надо отдельную процедуру писать
BOBAH13 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц, летом дешевле!

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск файлов LeoN Общие вопросы Delphi 5 25.11.2007 22:54
поиск файлов KORN Компоненты Delphi 3 12.10.2007 05:42
Поиск файлов necky Общие вопросы Delphi 10 31.08.2007 00:27
Просмотр файлов в папке и подпапках Yar Помощь студентам 9 07.08.2007 16:56