Тема: PlayList
Показать сообщение отдельно
  #8  
Старый 16.08.2008, 22:11
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
По умолчанию

Писал как-то, может пригодится. Читает плэйлисты PLS, M3U, LAP, WPL и простые списки, есть возможность определения типа плэйлиста. А себе можешь создать собственный формат, н-р, Advanced Playlist - *.ap Загружай все это дело в ListBox со столбцами: название песни из тега или имя файла, если тегов нет, продолжительность, путь к файлу и т. д. Глянь как это реализовано в FooBar.
Код:
////////////////////////////////
// -= Coded by Vayrus =- //
///////////////////////////////

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
IniFiles;

var
TIF: TIniFile;

procedure PLS_To_FileList(FName: string; OUTPUT: TStrings);
const
SectName='playlist';
ParamName='File';
var
I: Integer;
S: string;
begin
TIF:=TIniFile.Create(FName);
I:=1;
repeat
S:=TIF.ReadString(SectName,ParamName+IntToStr(I),'');
if S<>'' then
OUTPUT.Add(S);
INC(I);
until S='';
TIF.Free;
end;

//Данный вариант не тянет за собой IniFiles
procedure PLS_To_FileList2(FName: string; OUTPUT: TStrings);
const
FileTag='File';
var
F: TextFile;
S: string;
B, E, L: Integer;
begin
L:=Length(FileTag);
AssignFile(F, FName);
Reset(F);
while not eof(f) do
begin
Readln(F, S);
E:=Length(S);
B:=Pos(FileTag, S);
if B>0 then
begin
S:=Copy(S,B+L+2,E);
OUTPUT.Add(S);
end;
end;
CloseFile(F);
end;

function Is_PLS(FName: string): boolean;
const
SectName='[playlist]';
var
F: TextFile;
S: string;
begin
AssignFile(F, FName);
Reset(F);
Readln(F, S);
RESULT:=Pos(SectName, S)>0;
CloseFile(F);
end;

//Если M3U грузит нормально иначе грузит подряд
procedure M3U_To_FileList(FName: string; OUTPUT: TStrings);
const
FirstTag='#EXTM3U';
FileTag='#EXTINF';
var
F: TextFile;
S: string;
begin
AssignFile(F, FName);
Reset(F);
while not eof(f) do
begin
Readln(F, S);
if (Pos(FirstTag, S)=0) and (Pos(FileTag, S)=0) then
OUTPUT.Add(S);
end;
CloseFile(F);
end;

procedure LAP_To_FileList(FName: string; OUTPUT: TStrings);
const
FirstTag='>N';
var
F: TextFile;
S: string;
begin
AssignFile(F, FName);
Reset(F);
while not eof(f) do
begin
Readln(F, S);
if (Pos(FirstTag, S)=0) and (Length(S)>0) then
OUTPUT.Add(S);
end;
CloseFile(F);
end;

function Is_LAP(FName: string): boolean;
const
SectName='>N';
var
F: TextFile;
S: string;
begin
Result:=False;
AssignFile(F, FName);
Reset(F);
while not eof(F) do
begin
Readln(F, S);
if Pos(SectName, S)>0 then Result:=True;
end;
CloseFile(F);
end;

function Is_M3U(FName: string): boolean;
const
SectName='#EXTM3U';
var
F: TextFile;
S: string;
begin
AssignFile(F, FName);
Reset(F);
Readln(F, S);
RESULT:=Pos(SectName, S)>0;
CloseFile(F);
end;

procedure WPL_To_FileList(FName: string; OUTPUT: TStrings);
const
BeginTag='<media src="';
EndTag='" tid="';
var
F: TextFile;
S: string;
B, E, L: Integer;
begin
L:=Length(BeginTag);
AssignFile(F, FName);
Reset(F);
while not eof(f) do
begin
Readln(F, S);
B:=Pos(BeginTag, S);
if B>0 then
begin
E:=Pos(EndTag, S);
S:=Copy(S,B+L,E-B-L);
OUTPUT.Add(UTF8Decode(S));
end;
end;
CloseFile(F);
end;

function Is_WPL(FName: string): boolean;
const
SectName='<?wpl';
var
F: TextFile;
S: string;
begin
AssignFile(F, FName);
Reset(F);
Readln(F, S);
RESULT:=Pos(SectName, S)>0;
CloseFile(F);
end;

function Is_SimpleList(FName: string): boolean;
var
F: TextFile;
S: string;
B, E: Integer;
begin
B:=0;
E:=0;
AssignFile(F, FName);
Reset(F);
while not Eof(F) do
begin
Readln(F, S);
if ExtractFileExt(S)<>'' then Inc(B);//Сменить при необходимости  ///////////////////////////////////
Inc(E);
end;
RESULT:=B=E;
CloseFile(F);
end;

procedure ExtractFileListFromPlayList(FName: string; OUTPUT: TStrings);
const
Unknown='Данный тип плэйлистов не поддерживается.';
begin
if Is_PLS(FName) then PLS_To_FileList(FName, OUTPUT) else
if Is_WPL(FName) then WPL_To_FileList(FName, OUTPUT) else
if Is_M3U(FName) then M3U_To_FileList(FName, OUTPUT) else
if Is_LAP(FName) then LAP_To_FileList(FName, OUTPUT) else
if Is_SimpleList(FName) then OUTPUT.LoadFromFile(FName) else
ShowMessage(Unknown);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
ListBox1.Clear;
ExtractFileListFromPlayList(OpenDialog1.FileName,ListBox1.Items);
end;
end;

end.
Admin: Учимся правильно оформлять код. БАН на 5 дней.
Ответить с цитированием