Поиск в подкаталогах

[Mickset]

не компилирует, ошибку выбивает.

[mihali4]

Сообщение от DarkEvil

ScanDir(StartDir + SearchRec.Name + '',Mask.List);
точка а не запятая

Это на каком языке переменные разделяются не запятыми, а точками???

[Mickset]

Может кто уже поможет Что бы не развивать флудо-топик?

[raxp]

и то верно...

//поиск вложений-
procedure recurs(_dir,mask: string;_dest: TStrings;_subDirs:boolean);
var _sr: TSearchRec;
    _l : longint;
    _i : integer;

function ExtMatch(_fileext, _exts: string; _delimiter: char): boolean;
var _pos : longint;
begin
  Result:= false;
  //Check strings
  if (length(_fileext) = 0) or (length(_exts) = 0) then exit;
  //Rewrite strings
  _fileext := _delimiter + UpperCase(_fileext) + _delimiter;
  _exts := _delimiter + UpperCase(_exts) + _delimiter;
  //Search
  _pos := Pos(_fileext, _exts);
  //Found
  Result := (_pos <> 0);
end;
begin
 application.ProcessMessages;
 //
 _l:= length(_dir);
 if (_l=0) then exit;
 //rewrite path
 if (_dir[_l]<>':')and(_dir[_l]<>'\') then _dir:=_dir+'\';
 //Add files.
 _i:=FindFirst(_dir+'*.*',$37,_sr);
 while (_i=0) do
  begin
   //it's a directory
   if (_sr.Attr and $10 = $10) and (_sr.name <> '.') and
      (_sr.name <> '..') and (_subdirs)
       then recurs(_dir + _sr.name,mask,_dest,_subdirs) else
        if ExtMatch(ExtractFileExt(_sr.name),mask, ';') then
         if _dest.IndexOf(_dir + _sr.name) = -1
          then _dest.Add(_dir + _sr.name);
     _i:= FindNext(_sr);
   end;
 FindClose(_sr);
end;
//---



procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 recurs('d:\фильмы','.avi;',listbox1.Items,true)
end;

[Mickset]

Конечно Спасибо..
Ничего не подумайте, но я попросил подправить ту процедуру что была в первом посте..

[DarkEvil]

Сообщение от mihali4

Это на каком языке переменные разделяются не запятыми, а точками???

Мдя, думал об одном писал об ином )))

Сообщение от Mickset

Конечно Спасибо..
Ничего не подумайте, но я попросил подправить ту процедуру что была в первом посте..

Вот исправленый код

procedure ScanDir(StartDir, 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.Attr and faDirectory) <> 0 then
    begin
      if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
     ScanDir(StartDir + SearchRec.Name + '',Mask,List);
    end;
   until FindNext(SearchRec) <> 0;
   FindClose(SearchRec);
 end;
end;

[Serge_Bliznykov]

ничего так просто не получится!
Mickset, Ваш код и так ищет в подкаталогах.
НО!!
Ключевая проблема вот здесь:

if FindFirst(StartDir+Mask

Вход осуществляется в подкаталогах, которые имеют расширение, совпадающее с маской! Проверьте, ищите, например, по маске *.htm, тогда создайте подкаталоги TEST1.HTM KUKU_TEST2.HTM и проверьте...

исправить надо так - делать два цикла поиска в одной процедуре - первый, как у Вас, только НЕ ОБРАБАТЫВАТЬ ПОДКАТАЛОГИ. второй цикл - по маске *.* и исключительно обрабатывать только подкаталоги (с рекурсивным вызовом процедуры ScanDir)

p.s. 100% именно эта проблема (маска в поиске не давала искать по подкаталогам!) здесь на форуме уже решалась, можете порулить поиском!

[DarkEvil]

Сообщение от Serge_Bliznykov

ничего так просто не получится!
Mickset, Ваш код и так ищет в подкаталогах.
НО!!
Ключевая проблема вот здесь:

if FindFirst(StartDir[COLOR="Red"+]Mask[/COLOR]

Вы не правы, оно все отлично ищет, только проблема в двух строках кода
1:
Не правильно

if StartDir[Length(StartDir)] <> '' then StartDir := StartDir + '';

Правильно

if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';

Нет слешей
2:

if (SearchRec.Name <> '..') and (SearchRec.Name <> '.')

А здесь немного иная кострукция

 if (SearchRec.Attr and faDirectory) <> 0 then
    begin
      if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
     ScanDir(StartDir + SearchRec.Name + '',Mask,List);
    end;

[Serge_Bliznykov]

Вы не правы, оно все отлично ищет, только проблема в двух строках кода

Да что Вы мне рассказываете!?!?
что строка кода:

 if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then

при Mask <> '*.*' найдёт все подкаталоги!?
Ну так сделайте тестовую программку и проверьте, если Вы сомневаетесь для чего нужна маска файла в процедуре findfirst!

[DarkEvil]

Сообщение от Serge_Bliznykov

при Mask <> '*.*' найдёт все подкаталоги!?
Ну так сделайте тестовую программку и проверьте, если Вы сомневаетесь для чего нужна маска файла в процедуре findfirst!

Извиняюсь за невнимательность ...
Ночью был сонный и писал )))
В таком случае исправляю свой пример:

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  ScanDir('C:\', '.txt', Memo1.Lines);
end;