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

Вниз

Добавление вложенных папок в плейлист   Найти похожие ветки 

← →
GeLLeR ©   (2006-08-23 15:26) [0]

Вот код:

procedure ScanDir(StartDir: string; Mask: string; List: TStrings);
var
 SearchRec: TSearchRec;
begin
 if Mask = "" then
   Mask := "*.*";
 if StartDir[Length(StartDir)] <> "\" then
   StartDir := StartDir + "\";
 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;

procedure TMainForm.Openfolder1Click(Sender: TObject);
var i,filename:integer;
begin
if PathDialog1.Execute then
   ScanDir(PathDialog1.Path, "*mp3", PlayList_editor.ListBox1.Items);
end;

Как сделать чтобы додавлялись вложенные папки?  

---

← →
GeLLeR ©   (2006-08-23 15:28) [1]

Примечание. Далее в процедуре procedure TMainForm.Openfolder1Click(Sender: TObject); добавляются др. форматы, считается время и тд и тп

---

← →
unknown ©   (2006-08-23 15:42) [2]

> GeLLeR ©   (23.08.06 15:26)


procedure GetAllFiles(mask: string;var Box:TStrings);
var
 search: TSearchRec;
 directory: string;
begin
 if Box=nil then
   exit;
 directory := ExtractFilePath(mask);
 // find all files
 if FindFirst(mask, $23, search) = 0 then
 begin
   repeat
     // add the files to the listbox
     Box.Add(directory + search.Name);
   until FindNext(search) <> 0;
 end;
 // Subdirectories/ Unterverzeichnisse
 if FindFirst(directory + "*.*", faDirectory, search) = 0 then
 begin
   repeat
     if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> ".") then
       GetAllFiles(directory + search.Name + "\" + ExtractFileName(mask),Box);
   until FindNext(search) <> 0;
   SysUtils.FindClose(search);
 end;
end;

---

← →
GeLLeR ©   (2006-08-23 15:46) [3]

Пасибачки))))))0

---

← →
GeLLeR ©   (2006-08-23 15:57) [4]

Только хотелось бы ещё код с использованием этой прцедурки ато нефурычит...

---

← →
unknown ©   (2006-08-23 16:22) [5]

> GeLLeR ©   (23.08.06 15:57) [4]

procedure TForm1.Button1Click(Sender: TObject);
var
 Str:TStrings;
begin
 Str:=TStringList.Create;
 try
   GetAllFiles("G:\Music\*mp3", Str);
   Memo1.Lines.Text:=Str.Text;
 finally
   Str.Free;
 end;
end;

---

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

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

Наверх

Память: 0.47 MB
Время: 0.03 c