Главная страница
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.044 c
14-1088944443
Undert
2004-07-04 16:34
2004.07.25
St.-Petersburg + "W+" +" *DSL" + "Fairy Cow Unlimited"


3-1088473351
bigfoot
2004-06-29 05:42
2004.07.25
DBGrid + XML


1-1089801256
r0bert
2004-07-14 14:34
2004.07.25
проблема с запоминанием размеров окна


14-1088768593
AlexG
2004-07-02 15:43
2004.07.25
Кто может объяснить, что это за ошибка?


3-1088755929
Jann
2004-07-02 12:12
2004.07.25
работа с БД