Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.07.25;
Скачать: CL | DM;

Вниз

Аналог функции Add Folder из WinAmp a   Найти похожие ветки 

 
Paladin   (2004-07-09 20:01) [0]

Мне нужно, чтобы следующая процедура добавляла в listview все пути к файлам с расширением mask из startdir и (подкаталогов,но сами подкаталоги не добавляла)
Как в WinAmp - Add Folder, а что изменить я не догадался, подскажите, пожалуйста.
procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
 SearchRec : TSearchRec;
begin  
 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.Name <> "..") and (SearchRec.Name <> ".") then
begin
       List.Add(StartDir + SearchRec.Name + "\");
       ScanDir(StartDir + SearchRec.Name + "\",Mask,List);
     end;
   until FindNext(SearchRec) <> 0;
   FindClose(SearchRec);
 end;
end;


 
Mim1 ©   (2004-07-09 20:28) [1]

Вам надо искать по маске *.* и если найденый результат каталог то запускайте эту же функцию (рекурсия) с новыми параметрами, если же это не каталог то проверйте совподает ли имя файла наденому результату при помощи eqalmask ксли да то добавляйте в список.


 
Paladin   (2004-07-09 21:19) [2]

Неее, все должно быть проще... Хотя потом, если ничего не найдется - попробую.


 
Mim1 ©   (2004-07-10 13:32) [3]

Ну ну :)

program test;
{$APPTYPE CONSOLE}
uses sysutils, Masks;

procedure Q(startdir:string; mask:string);
var
SearchRec : TSearchRec;
begin
if FindFirst(StartDir+"\*.*", faAnyFile, SearchRec) = 0 then
begin
  repeat
    if (SearchRec.Attr and faDirectory) = faDirectory then
      begin
        if (SearchRec.Name <> "..") and (SearchRec.Name <> ".") then
          q(startdir+"\"+SearchRec.Name,mask);
      end
    else
      if MatchesMask(SearchRec.Name,mask) then
        writeln(StartDir +"\"+ SearchRec.Name);
  until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;
end;
begin
 q("d:\mp3","*.mp3");
end.


PS LMD



Страницы: 1 вся ветка

Текущий архив: 2004.07.25;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.041 c
14-1089102042
DiamondShark
2004-07-06 12:20
2004.07.25
А меня вот сомненья мучают


4-1086596495
Alex44
2004-06-07 12:21
2004.07.25
drag n drop API


14-1089079484
Думкин
2004-07-06 06:04
2004.07.25
С днем рождения! 6 июня


1-1089636739
Aleksandr.
2004-07-12 16:52
2004.07.25
Есть ли надежный метод отличить строку OEM от ANSI?


6-1085678736
Tipson
2004-05-27 21:25
2004.07.25
TWebbrowser -возможен ли стандатный статус бар?