カテゴリー「プログラミング」の記事

2009/10/09

メディアファイル情報取得

ネタが無いときは近況報告しろって誰かが言ってた。

というわけで、ドラッグ&ドロップしたフォルダ内のメディアファイル(wma,mp3)からタグ情報を読み取り、CSVに出力するツールを書きました。
Access用のツールとして作ってたけど、なんとなく便利そうなので一部を抜き出して公開。
下記のコードをテキストファイルにコピペして拡張子を「vbs」に変えたら動くはず。

'######################################################################
' ドラッグ&ドロップしたフォルダ以下のメディアファイル(wma,mp3)からタグ情報を取得
' 出力先はスクリプトのあるパス
'######################################################################

Dim ObjWshArg
Dim strFolderName
Dim ObjWshShell
Public ObjFS
Dim ObjFol
Dim ObjFiles
Public Const strCSVFileName = "mediafile.csv"
Public ObjTS

Set ObjCon = CreateObject("ADODB.Connection")
Set ObjFS = CreateObject("Scripting.FileSystemObject")
Set ObjTS = ObjFS.OpenTextFile(ObjFS.GetParentFolderName(WScript.ScriptFullName) & "/" & strCSVFileName ,2,1)

Set ObjWshArg = WScript.Arguments
strFolderName = ObjWshArg(0)

Set ObjFol = ObjFS.GetFolder(strFolderName)
Set ObjFiles = ObjFol.Files

sWriteTagInfo(ObjFol)

ObjTS.Close
Set ObjTS = Nothing

'ObjCon.Close
'Set ObjCon = Nothing
Set ObjFol = Nothing
Set ObjFS = Nothing
Set ObjWshArg = Nothing

msgbox "終了"

'######################################################################
' sWriteTagInfo
' 引数:folder ファイルを取得するフォルダオブジェクト
' 引数フォルダ下のファイル名をフルパスで書き出し(フォルダがある場合は再起呼び出し)
' 属性に関する技術資料:http://msdn.microsoft.com/en-us/library/aa385267(VS.85).aspx
'------------------------------------------------------------
'Author             'artist or actor
'WM/AlbumArtist     'the primary artist for the album
'WM/AlbumTitle      'the title of the album
'Title              'the title of the content
'WM/TrackNumber     'the track number of the item on the album
'CurrentBitrate     'the current bit rate of the item, in bits per second
'IsVBR              'whether the content was encoded using variable bit rate (VBR) encoding
'Duration           'the playing duration of the item, in seconds
'FileSize           'the size of the file in bytes
'######################################################################

Sub sWriteTagInfo(folder)

Dim ObjFiles
Dim ObjFolders
Dim objDrive
Dim strSQL
Dim ObjMediaPlayer
Dim ObjMediaFile
Dim strPath
Dim strFileName
Dim strAuthor
Dim strAlbumArtist
Dim strAlbumTitle
Dim strTitle
Dim strTrackNumber
Dim strCurrentBitrate
Dim strIsVBR
Dim strDuration
Dim strFileSize

Set ObjMediaPlayer = CreateObject("WMPlayer.OCX")

Set ObjFiles = folder.files
Set ObjFolders = folder.SubFolders
Set objDrive = ObjFS.GetDrive(folder.Drive)

strVolumeLabel = objDrive.VolumeName

ObjTS.WriteLine "ファイルパス,ファイル名,アーティスト,アルバムのアーティスト,アルバムタイトル,タイトル,トラック番号,ビットレート,VBR,演奏時間,ファイルサイズ"

For Each fFile in ObjFiles
  If Right(fFile.Path,3) = "wma" or Right(fFile.Path,3) = "mp3" Then
   Set ObjMediaFile = ObjMediaPlayer.newMedia(fFile.Path)
   'ファイルの属性値取得
   strAuthor = ObjMediaFile.getItemInfo("Author")
   strAlbumArtist = ObjMediaFile.getItemInfo("WM/AlbumArtist")
   strAlbumTitle = ObjMediaFile.getItemInfo("WM/AlbumTitle")
   strTitle = ObjMediaFile.getItemInfo("Title")
   strTrackNumber = ObjMediaFile.getItemInfo("WM/TrackNumber")
   strCurrentBitrate = ObjMediaFile.getItemInfo("CurrentBitrate")
   strIsVBR = ObjMediaFile.getItemInfo("IsVBR")
   strDuration = ObjMediaFile.getItemInfo("Duration")
   strDuration = CStr(Fix(strDuration / 60)) & ":" & Fix((strDuration mod 60))
   strFileSize = ObjMediaFile.getItemInfo("FileSize")

   strSQL = Replace(fFile.Path,"'","''") & _
            "," & Replace(fFile.Name,"'","''") & _
            "," & strAuthor & _
            "," & strAlbumArtist & _
            "," & strAlbumTitle & _
            "," & strTitle & _
            "," & strTrackNumber & _
            "," & strCurrentBitrate & _
            "," & strIsVBR & _
            "," & strDuration & _
            "," & strFileSize
   ObjTS.WriteLine strSQL
  End If
Next

For Each fFolder in ObjFolders
  sWriteTagInfo(fFolder)
Next
End Sub

| | コメント (2) | トラックバック (0)

2009/09/16

フォルダ内の全ファイルをTEXTに出力

最近、必要に迫られ「あるフォルダの下にあるファイルを全てリスト化する」というツールを書いた。
思いのほか便利だったのでソースを貼っておくことにする。

ちなみに、これをベースに、ディスクの中身リストをAccessのデータベースに取り込むツールも作って、何十ギガバイトもたまってしまったmp3ファイルの管理をしようとしてるんだけど、wmaのタグを読むのが大変そうで頓挫中。

以下ソース。
コピーしてテキストファイルに保存して、拡張子を「.wsh」か「.vbs」に変えれば使用可能。
使い方は、取得したいフォルダをドラッグ&ドロップで渡すだけ。

'###################################################################
' ドラッグ&ドロップしたフォルダ以下のファイル名をフルパスで取得
' 出力ファイル名はOutPutFileNameで指定(デフォルトは年月日時分秒+FILES.txt)
' 出力先はスクリプトのあるパス
'###################################################################

Dim ObjWshArg
Dim strFolderName
Dim ObjWshShell
Dim ObjFS
Dim ObjFol
Dim ObjFiles
Dim ObjFolders
Public ObjTS
Dim OutPutFileName

OutPutFileName = Year(now) & Right("0" & Month(now),2) & Right("0" & Day(now),2) & Right("0" & Hour(now),2) & Right("0" & Minute(now),2) &  Right("0" & Second(now),2) & "FILE.TXT"

Set ObjWshArg = WScript.Arguments
strFolderName = ObjWshArg(0)

Set ObjFS = CreateObject("Scripting.FileSystemObject")
Set ObjTS = ObjFS.OpenTextFile(ObjFS.GetParentFolderName(WScript.ScriptFullName) & "/" & OutPutFileName ,2,1)

Set ObjFol = ObjFS.GetFolder(strFolderName)
Set ObjFiles = ObjFol.Files

sWriteFilename(ObjFol)

ObjTS.Close
Set ObjTS = Nothing
Set ObjFol = Nothing
Set ObjFS = Nothing
Set ObjWshArg = Nothing

msgbox "終了"

'###################################################################
' sWriteFilename
' 引数:folder ファイルを取得するフォルダオブジェクト
' 引数フォルダ下のファイル名をフルパスで書き出し(フォルダがある場合は再起)
'###################################################################

Sub sWriteFilename(folder)

Dim ObjFiles
Dim ObjFolders

Set ObjFiles = folder.files
Set ObjFolders = folder.SubFolders

For Each fFile in ObjFiles
  ObjTS.WriteLine fFile.Path
Next

For Each fFolder in ObjFolders
  sWriteFilename(fFolder)
Next

End Sub

| | コメント (2) | トラックバック (0)