Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];

Вниз

Аналог функции 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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.035 c
9-1081886301
Kind
2004-04-13 23:58
2004.07.25
Карточная игрушка


8-1083638047
тихий вовочка
2004-05-04 06:34
2004.07.25
Как избежать пропадания рисунка


14-1089174057
leonidus
2004-07-07 08:20
2004.07.25
Идея


4-1087304170
ddrum
2004-06-15 16:56
2004.07.25
получение инфы о процессе


3-1088593282
Darthman
2004-06-30 15:01
2004.07.25
Firebird (Interbase) хочу через insert вставить дату





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский