2012年6月11日月曜日

ZenStyleM100-CreatePlayList v102

https://skydrive.live.com/redir?resid=8CD7CF5EA9FBCA55!390

size: 7KB

■概要
ZenStyleM100にてフォルダ別にプレイリストを作成する

■バージョン
ver 1.02 出力ファイル一覧を処理終了時にまとめて表示するように修正
ver 1.01 フォルダとファイルのタイムスタンプ(作成日時、更新日時)、m3u内のファイルの有無、ファイル数をチェックする機能を追加
ver 1.00 公開

■使い方
お使いのZenStyleM100のルートフォルダにCreatePlayList101.vbsを置いて実行してください。
ファイル内の outputDirectory および searchDirectory のパスを書き換えれば
お好きな位置で実行することもできます。

Musicフォルダ直下にあるフォルダ名で、PlayListフォルダにプレイリストが出力されます。
(デフォルトの場合)

■使い方(詳しく)
1. お使いのM100のルートフォルダにダウンロードしたCreatePlayList.vbsを置いてください。



2. CreatePlayList.vbsを実行
(windowsならダブルクリックで実行される。ほかは知らん)
確認ウィンドウがでるので良ければ[OK]


3. しばし終わるのを待つ
終わったら[終了]と出ます


その後本体起動時にリストのチェックが入るのか起動時間が長くなります。
気長にお待ちくださいませ。


無事プレイリストの読み込みが完了した

Musicフォルダには以下画像のように配置しています。

完了後のPlayListフォルダはこんな感じに。




■仕様
設定したフォルダパス(デフォではMusic)内にあるフォルダの数だけm3uを作成します。
たとえば、

G:.
├─Music
│ ├─フォルダ1
│ │ ├─01.mp3
│ │ └─02.mp3
│ ├─フォルダ2
│ │ ├─disc1
│ │ │ ├─01.mp3
│ │ │ ├─02.mp3
│ │ │ └─03.mp3
│ │ └─disc2
│ │   ├─01.mp3
│ │   ├─02.mp3
│ │   └─03.mp3
│ └─フォルダ3
├─Pictures
├─Video
├─Recorded
└─Playlist

って構成になっていたら作成されるm3uは
フォルダ1.m3u
フォルダ2.m3u
の2つが、PlayListフォルダに出力されます。
フォルダ2は中にさらにフォルダがありますが、
まとめてフォルダ2.m3uに保存されることになります。
またフォルダ3には曲がないのでフォルダ3.m3uは出力されません。

CreatePlayList.vbsの中身を書き換えることで、
出力先フォルダ、入力フォルダを変更することができます。
デフォルトではPlayListフォルダに出力する設定になっていますが、
既存のプレイリストとごちゃごちゃになるのが気になる方は出力先を変更すると良いでしょう。



■CreatePlayList102.vbsソースコード
' Zen Style M100の曲ファイルをフォルダ別にm3uにして、PlayListに保存するプログラム
' 2012-03-25 ver 1.02
' author sumishiro@gmail.com
' 本プログラムのご利用に際し如何なる損失や損害が発生しても、一切の責任を負いかねます。ご了承ください。
'
'
' 1012-05-26 ver 1.02
'     出力ファイル一覧を処理終了時にまとめて表示するように修正
' 1012-03-25 ver 1.01
'     フォルダとファイルのタイムスタンプ(作成日時、更新日時)、m3u内のファイルの有無、ファイル数をチェックする機能を追加
' 1012-03-21 ver 1.00
 
 
Option Explicit
 
 
 
Dim outputDirectory
Dim searchDirectory
Dim rootFileName
 
 
 
' m3u出力先。フォルダが存在しないと出力されないようなので注意
outputDirectory = ".\PlayList"
 
 
 
' 調べるディレクトリパス
' このディレクトリにあるフォルダ名でm3uファイルを作成し、
' 各フォルダ内にある音楽ファイルをm3uに突っ込む
' 同名のm3uは上書きされるので注意
searchDirectory = ".\Music"
 
 
 
' searchDirectoryに直接おいてある曲もm3uリストにしたい場合
' 以下に出力m3uファイル名を定義してね
' rootFileName = "root"
 
 
' 出力ファイル一覧をいれる
Dim outputFiles
outputFiles = ""
 
 
 
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
 
 
 
' 指定m3uファイルをチェック。
' ファイルがすべて存在してm3uとして問題がなければTrueを返す。
' 参照引数rLineNumに該当ファイルの行数(記述されたファイル数)を入れるが、
' 存在しないファイルがあった場合は最後までカウントしないので注意
Function checkPlayList( fileObj, rLineNum )
  Dim file
  Set file = fso.OpenTextFile( fileObj, 1, False, -1 )
 
  ' C: D:といったドライブ名を取得
  Dim driveName
  driveName = Left( searchDirectory, InStr(searchDirectory, "\") )
 
  rLineNum = 0
  Do Until file.AtEndOfStream=True
    Dim strLine
    strLine = file.ReadLine()
 
    If fso.FileExists(driveName & strLine)=False Then
      checkPlayList = False
      Exit Function
    End If
    
    rLineNum = rLineNum + 1
  Loop
 
  file.Close()
  checkPlayList = True
End Function
 
 
 
' m3uの作成が必要かどうかチェック。
' 指定した日時よりファイル日時のほうが新しければFalse, それ以外はTrue
' @return 作成の必要があるならばTrue
Function needCreatePlayListFile( filePath, dateTime, musicFileNum )
  If fso.FileExists(filePath) Then
    ' m3uが指定時刻より新しいかチェック。新しければ関数終了
    If fso.GetFile(filePath).DateLastModified < dateTime Then
      needCreatePlayListFile = True
      Exit Function
    End If
 
    ' m3uファイルの妥当性チェック
    Dim lineNum
    If checkPlayList(fso.GetFile(filePath), lineNum) Then
      ' 数チェック
      If lineNum=musicFileNum Then
        needCreatePlayListFile = False
        Exit Function
      End If
    End If
 
  End If
 
  needCreatePlayListFile = True
End Function
 
 
 
' 引数date, file.更新日時, file.作成日時の3つの中から一番最新の日時を返す
' fileにはFileオブジェクトかFolderオブジェクト
Function getMostNewDate( file, date )
  Dim tmp
  tmp = date
 
  If file.DateLastModified %gt; tmp Then
    tmp = file.DateLastModified
  End If
 
  If file.DateCreated %gt; tmp Then
    tmp = file.DateCreated
  End If
 
  getMostNewDate = tmp
End Function
 
 
 
' 指定ファイル名とoutputDirectoryからm3uファイルのパスを作成
Function createM3UFilePath( fileName )
  createM3UFilePath = fso.BuildPath( outputDirectory, fileName & ".m3u" )
End Function
 
 
 
' m3uファイル作成
' @param fileNameには拡張子はつけない
' あらかじめ設定した出力先にfileNameを結合してUNICODEで保存
Function createM3UFile( filePath, fileData )
  If Len(fileData) %gt; 0 Then
    Dim file
    Set file = fso.OpenTextFile( filePath, 2, True, -1 )
    file.Write( fileData )
    file.Close
 
    createM3UFile = True
 
'    WScript.Echo "create " & fso.GetAbsolutePathName(filePath)
    outputFiles = outputFiles & fso.GetAbsolutePathName(filePath) & vbNewLine
  Else
    createM3UFile = False
  End If
End Function
 
 
 
' パスからドライブ名を除く
' [c:\folder\folder\file.ext]-%gt;[\folder\folder\file.ext]
Function delDriveName( filePath )
  Dim pos
  pos = InStr( filePath, "\" )
 
  Dim strLen
  strLen = Len( filePath )
 
  Dim ret
  ret = Right( filePath, strLen-pos+1 )
 
  delDriveName = ret
End Function
 
 
 
' ディレクトリ内にあるwmv, mp3, wav, ogg ファイルのパスをfileDataに列挙。
' そのときC:などのドライブ名は削除し\Music~といったファイルパスに変換されて保存する
Function scanMusicFile( dirObj, fileData, mostNewDate )
  Dim fileNum
  fileNum = 0
  
  Dim fileObj
  For Each fileObj In dirObj.Files
    Dim ext
    ext = LCase( fso.GetExtensionName(fileObj) )
    If ext="wmv" Or ext="mp3" Or ext="wav" Or ext="ogg" Then
      mostNewDate = getMostNewDate( fileObj, mostNewDate )
 
      fileData = fileData & delDriveName( fileObj ) & vbNewLine
      fileNum = fileNum + 1
    End If
  Next
  
  scanMusicFile = fileNum
End Function
 
 
 
' ディレクトリ走査
' 音楽ファイルへのパスをあつめるところまで
Sub scanDirectory( dirObj, fileData, mostNewDate, musicFileNum )
  mostNewDate = getMostNewDate( dirObj, mostNewDate )
 
  Dim subDirObj
  For Each subDirObj In dirObj.SubFolders
    Call scanDirectory( subDirObj, fileData, mostNewDate, musicFileNum )
  Next
 
  musicFileNum = musicFileNum + scanMusicFile( dirObj, fileData, mostNewDate )
End Sub
 
 
 
' searchDirectoryに定義したパスを走査
Sub scanRootDirectory( dirPath )
  Dim src
  Set src = fso.GetFolder( dirPath )
 
  Dim filePath
 
  Dim subDirObj
  For Each subDirObj In src.SubFolders
    Dim fileData
    Dim mostNewDate
    Dim musicFileNum
 
    fileData = ""
    mostNewDate = subDirObj.DateLastModified
    musicFileNum = 0
    Call scanDirectory( subDirObj, fileData, mostNewDate, musicFileNum )
    
    filePath = createM3UFilePath( fso.GetFileName(subDirObj) )
    If needCreatePlayListFile(filePath, mostNewDate, musicFileNum) Then
      Call createM3UFile( filePath, fileData )
    End If
  Next
 
  ' searchDirectoryにある曲をm3u出力する
  If Len(rootFileName) %gt; 0 Then
    fileData = ""
    mostNewDate = src.DateLastModified
    musicFileNum = scanMusicFile( src, fileData, mostNewDate )
    
    filePath = createM3UFilePath( rootFileName )
    If needCreatePlayListFile(filePath, mostNewDate, musicFileNum) Then
      Call createM3UFile( filePath, fileData )
    End If
  End If
End Sub
 
 
 
' 処理の開始
outputDirectory = fso.GetAbsolutePathName( outputDirectory )
searchDirectory = fso.GetAbsolutePathName( searchDirectory )
 
Dim message
message = "処理を開始します" & vbNewLine & "input = " & searchDirectory & vbNewLine & "output = " & outputDirectory 
 
If MsgBox(message, 1, "確認")=1 Then
  Call scanRootDirectory( searchDirectory )
 
  If Len(outputFiles)%gt;0 Then
    WScript.Echo outputFiles
  End If
 
  MsgBox("終了")
End If

 生成したファイル確認を表示を一括にして、とても若干便利に。

 曲の追加や削除をしたにもかかわらず、
本体のプレイリストに反映されない場合があります。
その場合、PlayListフォルダを_PlayListなどにリネームし本体を起動、
その後またPlayListに戻して本体を起動すると、
強引に認識しなおさせることができるようです。

0 件のコメント: