m3u 形式のプレイリストを読み込もうというページ。

上記の参考サイトによるとm3uプレイリストの形式は、

1. メディアの絶対パスまたは相対パスを再生順に一行ずつ記述する。
2. 相対パスは、そのプレイリストがあるフォルダを基点としたものとなる。
3. m3uプレイリスト中にあるm3uプレイリストは無視。
4. 行頭に"#"があればその行はコメントとみなす。

といったもののようです。
ファイル名が再生順に書かれているのでTStringsのLoadFromFileメソッドで読み込めば良いので手間はありません。
ただ相対パスの扱いと行頭に#があった場合、プレイリストが書かれてあった場合に対処しようとすると少しややこしくなります。

簡単な例

まず、相対パスやコメントなどに対処しない一番簡単な読み込みの例です。

procedure ReadM3uList(sFile: WideString; slList: TStrings);
//m3uプレイリストを読み込む。
begin
  slList.Clear;
  //リストを読み込む。
  slList.LoadFromFile(sFile);
end;

ただ読み込むだけです。

コメントやプレイリストに対処した例

次にコメントとプレイリストに対処した例です。

まずファイルがプレイリストかどうかを返す関数を作ります。
ファイルがプレイリストかどうかはファイルの拡張子だけをみて判定しています。

function IsPlaylist(sFile: WideString): Boolean;
//sFileの拡張子がプレイリストのものであればTrueを返す。
var
  ls_Ext: WideString;
begin
  //拡張子を取得。
  ls_Ext := WideUpperCase(gfnsFileExtGet(sFile));
  if (ls_Ext = '.M3U')
  or (ls_Ext = '.M3U8')
  or (ls_Ext = '.PLS')
  or (ls_Ext = '.WPL')
  then begin
    Result := True;
  end else begin
    Result := False;
  end;
end;

LoadFromFileメソッドで読み込んだ後、リストの後ろから見て行き、空行やコメント、プレイリストであったらリストから削除します。
コメントについては#で始まるファイル名もありうることから、先頭行が#EXTM3Uの場合と行頭が#EXTINF:の追加情報の場合のみ削除するようにしています。
存在しないファイルも削除するならコメントアウトを外します。

procedure ReadM3uList(sFile: WideString; slList: TStrings);
//m3uプレイリストを読み込む。
var
  i: Integer;
  ls_File: WideString;
begin
  slList.Clear;
  //リストを読み込む。
  slList.LoadFromFile(sFile);
  for i := slList.Count-1 downto 0 do begin
    ls_File := Trim(slList[i]);
    if (ls_File = '')                       //空行。
    or ((i = 0) and (ls_File = '#EXTM3U')) //先頭行が#EXTM3U。
    or (Pos('#EXTINF:', ls_File) = 1)       //追加情報。残すならコメントアウト。
    or (IsPlaylist(ls_File))                //プレイリスト。
//    or not(FileExists(ls_File))              //存在しないファイル。
    then begin
      //追加情報もしくは空行、あるいはプレイリストなのでリストから削除。
      slList.Delete(i);
    end;
    Application.ProcessMessages;
  end;
end;

相対パスにも対応した例

相対パスに対応するにはプレイリストのフォルダを基点とした絶対パスを作り出す必要があります。

//相対パス→絶対パス。
function gfnsAbsolutePathGet(sFile, sBasePath: WideString): WideString;
//sFileが絶対パスでなければsBasePathを基点とした相対パスであるとみなした絶対パスのファイル名を返す。
  function lfns_GetFullPathName(sFile: WideString): WideString;
  var
    li_Len: Integer;
    lp_Buff, lp_Name: PWideChar;
  begin
    li_Len := GetFullPathNameW(PWideChar(sFile), 0, nil, lp_Name);
    lp_Buff := AllocMem((li_Len +1) * 2);
    try
      GetFullPathNameW(PWideChar(sFile), li_Len +1, lp_Buff, lp_Name);
      Result := WideString(lp_Buff);
    finally
      FreeMem(lp_Buff);
    end;
  end;
var
  ls_Drive, ls_File: WideString;
begin
  ls_File  := sFile;
  ls_Drive := gfnsFileDriveGet(ls_File);

  if (ls_Drive = '') then begin
    //ドライブ名がないので相対パス。
    if (ls_File[1] = '\') then begin
      //ドライブ直下。
      Result := lfns_GetFullPathName(gfnsFileDriveGet(sBasePath) + ls_File);
    end else begin
      if (sBasePath[Length(sBasePath)] <> '\') then begin
        ls_File := sBasePath + '\' + ls_File;
      end else begin
        ls_File := sBasePath + ls_File;
      end;
      Result := lfns_GetFullPathName(ls_File);
    end;
  end else begin
    if (Pos('..\', ls_File) > 0) then begin
      //'..\'がファイル名中にあるので相対パス。ただしsBasePathとは直接関係無し。
      Result := lfns_GetFullPathName(sFile);
    end else begin
      //ドライブ名があり'..\'もないのでもともと絶対パス。
      Result := sFile;
    end;
  end;
end;

相対パスから絶対パスにする関数が少しややこしいだけで読み込む本体の処理は、プレイリストに残すファイル名を相対パスから絶対パスに変換する処理が追加になるだけです。

procedure ReadM3uList(sFile: WideString; slList: TStrings);
//m3uプレイリストを読み込む。
var
  i: Integer;
  ls_File, ls_Path: WideString;
begin
  ls_Path := gfnsFilePathGet(sFile); //相対パスだったときのため。

  slList.Clear;
  //リストを読み込む。
  slList.LoadFromFile(sFile);
  for i := slList.Count-1 downto 0 do begin
    ls_File := Trim(slList[i]);
    if (ls_File = '')                       //空行。
    or ((i = 0) and (ls_File = '#EXTM3U')) //先頭行が#EXTM3U。
    or (Pos('#EXTINF:', ls_File) = 1)       //追加情報。残すならコメントアウト。
    or (IsPlaylist(ls_File))                //プレイリスト。
    then begin
      //追加情報もしくは空行、あるいはファイル名がプレイリストなのでリストから削除。
      slList.Delete(i);
    end else begin
      slList[i] := gfnsAbsolutePathGet(ls_File, ls_Path);
//    if not(FileExists(slList[i])) then begin //ファイルが存在しない場合は削除。
//      slList.Delete(i);
//    end;
    end;
    Application.ProcessMessages;
  end;
end;

汎用ルーチン

ドライブ名を返す関数。

function gfnsFileDriveGet(sFile: WideString): WideString;
//Unicode対応ExtractFileDrive。
const
  lcs_DRIVEDELIM = WideString(':');
  lcs_PATHDELIM  = WideString('\');

  function lfns_DriveGet(sDrive: WideString; iIndex: Integer): WideString;
  begin
    if (WideUpperCase(sDrive[iIndex])[1] in [WideChar('A')..WideChar('Z')]) then begin
      Result := Copy(sFile, iIndex, 2);
    end else begin
      Result := '';
    end;
  end;
  function lfns_UncGet(sDrive: WideString; iIndex, iLen: Integer): WideString;
  //UNC名を返す。
  var
    i: Integer;
    iServer: Integer;
  begin
    Result := '';
    i := iIndex;
    iServer := -1;
    while (i < iLen) do begin
      if (sDrive[i] = lcs_PATHDELIM) then begin
        if (i = iIndex) then begin
          Exit; //サーバー名が''。
        end else begin
          if (iServer <> -1) then begin
            if ((iServer + 1) = i) then begin
              Exit; //共有フォルダ名が''。
            end else begin
              Break;
            end;
          end else begin
            iServer := i;
          end;
        end;
      end;
      Inc(i);
    end;
    if (iServer <> -1) and (iServer < iLen) then begin
      if (sDrive[i] = lcs_PATHDELIM) then Dec(i);
      Result := Copy(sDrive, iIndex, i - iIndex + 1);
      if (Result <> '') then Result := '\\' + Result;
    end;
  end;
var
  li_Len: Integer;
begin
  Result := '';
  li_Len := Length(sFile);
  if (li_Len >= 2) then begin
    //2文字以上。
    //1文字以下の場合はドライブ名とはみなさない。
    if (sFile[2] = lcs_DRIVEDELIM) then begin
      //C:〜など。
      Result := lfns_DriveGet(sFile, 1);
    end else if (sFile[1] = lcs_PATHDELIM) and (sFile[2] = lcs_PATHDELIM) then begin
      if (li_Len >= 8) and (WideUpperCase(Copy(sFile, 1, 8)) = '\\?\UNC\') then begin
        //\\?\UNC\〜。
        Result := lfns_UncGet(sFile, 9, li_Len);
      end else if (li_Len >= 3) and (sFile[3] = '?') then begin
        //\\?\〜。
        if (li_Len >= 6) and (sFile[6] = lcs_DRIVEDELIM) then begin
          Result := lfns_DriveGet(sFile, 5);
        end;
      end else begin
        //\\〜 UNC。
        Result := lfns_UncGet(sFile, 3, li_Len);
      end;
    end;
  end;
end;

パス名を返す関数。

function gfnsFilePathGet(sFile: WideString): WideString;
{
Unicode対応ExtractFilePath。
ドライブ名も含む。
末尾の'\'はつく。
ドライブ名のみの場合も'\'はつく。
ただしパスが空文字の場合のみ'\'はつかない。
}
var
  i: Integer;
begin
  Result := '';
  if (sFile <> '') then begin
    for i := Length(sFile) downto 1 do begin
      if (sFile[i] = '\') or (sFile[i] = '/') then begin
        Result := Copy(sFile, 1, i);
        Break;
      end else if (sFile[i] = ':') then begin
        Result := Copy(sFile, 1, i) + '\';
        Break;
      end;
    end;
  end;
end;

拡張子を返す関数。

function gfnsFileExtGet(sFile: WideString): WideString;
//Unicode対応ExtractFileExt。
//'.'は返る。
var
  i: Integer;
begin
  Result := '';
  for i := Length(sFile) downto 1 do begin
    if (sFile[i] = '\') or (sFile[i] = '/') or (sFile[i] = ':') then begin
      //拡張子なし。
      Break;
    end else if (sFile[i] = '.') then begin
      //拡張子あり。
      Result := Copy(sFile, i, MaxInt);
      Break;
    end;
  end;
end;

2010-09-01: