Программный поиск файлов

[the_beginer]

программно ищем файл, название которого пишем в edit1, результат выводим в edit2

Код: Выделить всё

var
  Form1: TForm1;
  b : boolean;
     
implementation

{ TForm1 }
procedure TForm1.FindFile(dir, conffile:String);
Var fs : TSearchRec;
     
begin

 findfirst(dir + '/*',faAnyFile,fs);
 repeat
  if (fs.Name='.') or (fs.Name='..') then continue;

  if (fs.Name='dev') then continue;
  if (fs.Name='home') then continue;
  if (fs.Name='mnt') then continue;

  if (fs.Attr and faDirectory) <> 0
     then findfile(dir + '/' + fs.name, conffile);

  if conffile = fs.Name
     then begin
            edit2.Text := dir + '/' + fs.Name;
            b := true;
          end;
  if b then exit;
 until findnext(fs) <> 0;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
 b := false;
 FindFile('', edit1.Text);
 showmessage('поиск окончен');
end;   

это все в принципе работает, но!
теперь собственно вопрос:
1.Я не просто так игнорирую папки home и mnt. Почему-то если искать и в этих каталогах, поиск файла дает ВСЕГДА отрицательный результат. Даже если искомый файл находится ну например в каталоге /etc.

Я грешил на то, что вся проблема в том, что в каталога home и mnt есть файлы с русскими буквами в названиях.
Однако, чуть позже выяснил, что поиск глючит, если еще искать в каталоге /dev Но в /dev кириллицей и не пахнет!

Уважаемый all,
подскажите в чем загвоздка?

кстати, запускаем программу под рутом

[Padre_Mortius]

Для начала стоит выровнять большие и маленькие буквы

Код: Выделить всё

if UpperСase(conffile) = UpperCase(fs.Name)

И также закрыть поиск с помощью FindClose

Добавлено спустя 33 минуты 2 секунды:
В качестве примера можно посмотреть по ссылке http://freepascal.ru/forum/viewtopic.php?f=13&t=3393&p=24063#p24063

[the_beginer]

впрочем, переписал процедуру поиска так

Код: Выделить всё

procedure TForm1.FindFile(dir, conffile:String);
Var fs : TSearchRec;
     s : string;
begin

 findfirst(dir + '/*',faAnyFile,fs);
 repeat
  if (fs.Name='.') then continue;
  if (fs.Name='..') then continue;
{
  if (fs.Name='dev') then continue;
}
  if (fs.Name='home') then continue;
  if (fs.Name='mnt') then continue;

  if (fs.Attr and faDirectory) <> 0
     then begin
           s := fs.name;
           findfile(dir + '/' + s, conffile);
          end;
          
  if conffile = fs.Name
     then begin
            edit2.Text := dir + '/' + fs.Name;
            b := true;
          end;
          
  if b
     then begin
            findclose(fs);
            exit;
          end;
          
 until findnext(fs) <> 0;
 findclose(fs);
end; 

и получил, вот такой ответ в edit2.text:
/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21
/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21
/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21/dev/fd/21
/dev/fd/21/dev/fd/21/etc/lilo.conf

все одной строкой

все таки поиск в /dev нада исключать, но почему?

[Brainenjii]

куча ссылок внутри /dev на себя же?

[Padre_Mortius]

количество /dev/fd/21 обозначает количество вхождений в эту папку

Добавлено спустя 3 часа 27 минут 23 секунды:

Код: Выделить всё

procedure TForm1.FindFile(dir, conffile:String);
var
  fs : TSearchRec;
  s : string;
begin
  findfirst(dir + '/*',faAnyFile,fs);
  repeat
    if (fs.Name<>'.') and (fs.Name<>'..') then
      if (fs.Attr and faDirectory) <> 0 then
      begin
        s := fs.name;
        findfile(dir + '/' + s, conffile);
      end else
        begin
          if conffile = fs.Name then
          begin
            edit2.Text := dir + '/' + fs.Name;
            b:= true;
            Exit;
          end;
        end;
    Form1.Caption := fs.Name;
    Application.ProcessMessages;
    if b then exit;
  until findnext(fs) <> 0;
  findclose(fs);
end;

Попробуй вот так. у меня нормально отработало.

[the_beginer]

Попробуй вот так. у меня нормально отработало.

и твой и мой код рабочие.но проблема осталась

покопался я тут и нашел странную вещь:

у меня есть каталог /usr/share/icons/mdk-hicolor, в котором есть линк normal на /usr/share/icons

так вот поиск отработав каталог /usr/share/icons/mdk-hicolor попадает на этот линк и вновь работает с каталогом /usr/share/icons/mdk-hicolor но уже под названием /usr/share/icons/mdk-hicolor/normal/mdk-hicolor. Там вновь попадает на линк и снова работает с нашим каталогом но уже под названием /usr/share/icons/mdk-hicolor/normal/mdk-hicolor/normal/mdk-hicolor.

Т.е. фактически зацикливается. C /dev походу та же проблема

Пытался обойти эту проблему так:

Код: Выделить всё

     if (fs.Attr and fasymlink) <> 0   then continue;

но это не сработало! После небольшого исследования обнаружил, что атрибут каталога и линка на каталог одинаковый (у меня равен fs.attr = 48, где fs : TSearchRec). Другими словами не делается различия между каталогом и линком на каталог. С файлом и линком на файл та же байда.

как дать понять программе, что перед нами линк на каталог, а не каталог?

[B4rr4cuda]

как дать понять программе, что перед нами линк на каталог, а не каталог?

Код: Выделить всё

if FPS_ISLNK(fs.Attr) then continue;

Не забываем добавить BaseUnix в uses.

[the_beginer]

как дать понять программе, что перед нами линк на каталог, а не каталог?

Код: Выделить всё

if FPS_ISLNK(fs.Attr) then continue;

Не забываем добавить BaseUnix в uses.

при всем уважении - не работает

Код: Выделить всё

uses .... , BaseUnix;

procedure TForm1.FindFilo (dir:String);
Var fs : TSearchRec;
begin

 findfirst(dir + '/*',faAnyFile,fs);
 repeat
  if (fs.Name='.') or (fs.Name='..') then continue;

 if FPS_ISLNK(fs.Attr) = true
    then listbox1.Items.Add('==link==' + fs.name)
     else listbox1.Items.Add('=folder=' + fs.name);
     
 until findnext(fs) <> 0;
 findclose(fs);
end;   

всё показывает как =folder=, хотя есть один линк

[Alexx2000]

Если использовать функцию FPS_ISLNK, то надо делать вот так:

Код: Выделить всё

if FPS_ISLNK(fs.Mode) then continue;

[the_beginer]

Если использовать функцию FPS_ISLNK, то надо делать вот так:
if FPS_ISLNK(fs.Mode) then continue;

исправил на

Код: Выделить всё

if FPS_ISLNK(fs.mode) = true
    then listbox1.Items.Add('==link==' + fs.name)
     else listbox1.Items.Add('=folder=' + fs.name);

не-а, не работает
всё показывает как =folder=

[B4rr4cuda]

Таки да. Неладно в датском королевстве...
Этот вариант у меня работает:

Код: Выделить всё

procedure FindFilo (dir:String);
Var fs : TSearchRec; fst:Stat;
begin
findfirst(dir + '/*',faAnyFile,fs);
repeat
  if (fs.Name='.') or (fs.Name='..') then continue;

if fpReadLink(dir+'/'+fs.Name)<>''
    then form1.listbox1.Items.Add('==link==' + fs.name+' '+fpReadLink(dir+'/'+fs.Name))
     else form1.listbox1.Items.Add('=folder=' + fs.name);

until findnext(fs) <> 0;
findclose(fs);
end;

[the_beginer]

хех, вот в чем сила интернета

заработала !

Пасиба!

[B4rr4cuda]

Нема за шо. %)

[the_beginer]

итак подводя итоги - программный поиск фалов (а также каталогов или линков)
---------------------------------------------------------------------------------------------------

Код: Выделить всё

uses ... , BaseUnix;

  .......

var
  Form1: TForm1;
  b : boolean;
  ffile : string;
  
  ......

procedure TForm1.FindFile(dir, conffile:String);
Var fs : TSearchRec;
begin
 if dir = '/' then dir := '';
 findfirst(dir + '/*',faAnyFile,fs);
 repeat
  application.ProcessMessages;
  if (fs.Name='') or(fs.Name='.') or (fs.Name='..') then continue; 
                                                                //(fs.Name='') включать обязательно, 

  if conffile = fs.Name                //проверку на совпадение проводим сразу
     then begin                            //возможно мы ищем каталог или ссылку
            ffile := dir + '/' + fs.Name;
            b := true;
          end;

  if b
     then begin
            findclose(fs);
            exit;
          end;

  if fpReadLink(dir+ '/' +fs.Name) <> '' then continue;    //если линк, то пропускаем, 
                                                                                 //чтобы избежать циклических ссылок

  if ((fs.Attr and faDirectory) <> 0)                  //если каталог, 
     then findfile(dir + '/' + fs.name, conffile);  //то запускаем эту же функцию, 
                                                                    //но с новым каталогом



 until findnext(fs) <> 0;
findclose(fs);
end; 

procedure TForm1.Button1Click(Sender: TObject);
begin
 b := false;
 FindFile(edit1.Text, edit2.Text); //1-параметр - путь поиска, 2-ой - имя искомого
 edit3.Text := ffile;                     //результаты поиска - полный путь и название файла
 showmessage('поиск окончен');
end;

---------------------------------------------------------------------------------------------------

классика! В FAQ, однозначно :)

[Padre_Mortius]

Для FAQ имхо лучше убрать continue, т.к. очень близко к label и goto. Да и читабельность кода будет лучше