Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Файловая система
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 31.07.2008, 21:02
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию Поисковик

Помогите исправить поисковик файлов по расширеню
В общем использую следующий алгоритм для поиска
Код:
procedure TdlgSearchResults.SearchDir(Dir,Ext: string);
var
  SR: TSearchRec;
  FindRes: Integer;
  Item:TListItem;
begin
  FindRes := FindFirst(Dir + Ext, faAnyFile, SR);
       while FindRes = 0 do
          begin
            if ((SR.Attr and faDirectory) = faDirectory) and 
            ((SR.Name = '.') or (SR.Name = '..')) then 
               begin 
                 FindRes := FindNext(SR); 
                 Continue; 
               end; 
            if ((SR.Attr and faDirectory) = faDirectory) then 
              begin 
                SearchDir(Dir + SR.Name + '\',Ext);
                FindRes := FindNext(SR); 
                Continue; 
              end;
            //Files.Add(Dir + SR.Name);//Add to list
            Item:=lvFiles.Items.Add;
            Item.Caption:=SR.Name;
            Item.SubItems.Add(IntToStr(SR.Size));
            Item.SubItems.Add(Dir);
            //showmessage(dir+sr.Name);
            FindRes := FindNext(SR);
          end;
  FindClose(FindRes);
end;
При поиске файлов по маске *.* находит все, при поиске к примеру *.exe находит первый файл и прекращает искать.
При поиске к примеру *p* работает отлично, то же самое и при поиске без точки *exe*.
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию
Ответить с цитированием
  #2  
Старый 31.07.2008, 21:13
ART ART вне форума
Продвинутый
 
Регистрация: 13.02.2006
Адрес: Магнитогорск
Сообщения: 669
Репутация: 14745
По умолчанию

Попробуй это:

Код:
function TForm1.FileMaskEquate(F, M: string): boolean;
var
  Fl, Ml: integer; // length of file name and mask
  Fp, Mp: integer; // pointers
begin
  F := UpperCase(F);
  M := UpperCase(M);
  result := true;
  Fl := length(F);
  Ml := length(M);
  Fp := 1;
  Mp := 1;
  while Mp <= Ml do
  begin // wildcard
    case M[Mp] of //
      '?':
        begin // if one any char
          inc(Mp); // next char of mask
          inc(Fp); // next char of file name
        end; //
      '*':
        begin // if any chars
          if Mp = Ml then
            exit; // if last char in mask then exit
          if M[Mp + 1] = F[Fp] then
          begin // if next char in mask equate char in
            Inc(Mp); // file name then next char in mask and
          end
          else
          begin // else
            if Fp = Fl then
            begin // if last char in file name then
              result := false; // function return false
              exit; //
            end; // else, if not previous, then
            inc(Fp); // next char in file name
          end; //
        end; //
    else
      begin // other char in mask
        if M[Mp] <> F[Fp] then
        begin // if char in mask not equate char in
          result := false; // file name then function return
          exit; // false
        end; // else
        if (Mp=Ml) and (Fp<>Fl) then begin
        Result:=false;
        exit;
       end;
        inc(Fp); // next char of mask
        inc(Mp); // next char of file name
      end //
    end;
  end;
end;

procedure TdlgSearchResults.SearchDir(Dir: string; var Ext: string);
var
  SR: TSearchRec;
  FindRes: Integer;
  Item:TListItem;
begin
  FindRes := FindFirst(Dir + '*.*', faAnyFile, SR);
       while FindRes = 0 do
          begin
            if ((SR.Attr and faDirectory) = faDirectory) and
            ((SR.Name = '.') or (SR.Name = '..')) then
               begin
                 FindRes := FindNext(SR);
                 Continue;
               end;
            if ((SR.Attr and faDirectory) = faDirectory) then
              begin
                SearchDir(Dir + SR.Name + '\',Ext);
                FindRes := FindNext(SR);
                Continue;
              end;
            //Files.Add(Dir + SR.Name);//Add to list
	    if FileMaskEquate(SR.Name, Ext) = true then begin
             Item         := lvFiles.Items.Add;
             Item.Caption := SR.Name;
             Item.SubItems.Add(IntToStr(SR.Size));
             Item.SubItems.Add(Dir);
            end;
            //showmessage(dir+sr.Name);
            FindRes := FindNext(SR);
          end;
  FindClose(FindRes);
end;
Ответить с цитированием
  #3  
Старый 31.07.2008, 21:40
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
Подмигивание

Спасибо, все работает
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию
Ответить с цитированием
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:12.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025