中国DOS联盟论坛 - Powered by Discuz! Board

标题: [原创]用vbs读取mp3文件头(暂时只能读取id3v2) [打印本页]

作者: 3742668 时间: 2006-10-15 10:44 标题: [原创]用vbs读取mp3文件头(暂时只能读取id3v2)

读取mp3文件头，大家帮忙测试。附上主要参考资料: MP3 的头信息 ID3

On Error Resume Next

    strFile = GetFileName()
    If Len(Trim(strFile)) = 0 Then WScript.Quit
    PrintInfo(strFile)

'**********************************************************************************
'处理mp3
'**********************************************************************************
Sub PrintInfo(strFile)

Set objDictionary = CreateObject("Scripting.Dictionary")
Set objStream = CreateObject("ADODB.Stream") 
    objStream.Type = 1 
    objStream.Open 
    objStream.LoadFromFile strFile 
    objStream.position = 0 
    If Not Ucase(GetStr(objStream.Read(3))) = "ID3" Then 
        WScript.Echo "该文件不是id3格式!"
        WScript.Quit
    End If
    objStream.position = 6 
    binTotalLen = objStream.Read(4)
    '总长度
'    intTotalLen = Ascb(Midb(binTotalLen,1,1)) * 2097152 + _
'                  Ascb(Midb(binTotalLen,2,1)) * 1024 + _
'                  Ascb(Midb(binTotalLen,3,1)) * 128 + _ 
'                  Ascb(Midb(binTotalLen,4,1))
    Do
        strFrameID = GetStr(objStream.Read(4))        
        If Len(Trim(strFrameID)) = 0 Then Exit Do
        binSize = objStream.Read(4)
        intSize = Ascb(Midb(binSize,1,1)) * 4294967296 + _
                  Ascb(Midb(binSize,2,1)) * 65536 + _
                  Ascb(Midb(binSize,3,1)) * 256 + _
                  Ascb(Midb(binSize,4,1))
        objStream.Read(2)
        i = 0
        While Ascb(objStream.Read(1)) = 0 
            i = i + 1
            If intSize - i < 1 Then Exit Do
        Wend
        objStream.Position = objStream.Position - i
        objDictionary.Add strFrameID,GetStr(objStream.Read(intSize - i))
        
    Loop 
    
    For Each i In objDictionary.Keys 
        str2 = objDictionary.Item(i)
        Select Case UCase(i)
            Case "TIT2"
                str1 = "标题"
            Case "TPE1"
                str1 = "作者"
            Case "TALB"
                str1 = "专集"
            Case "TRCK"
                str1 = "音轨"
            Case "年代"
                str1 = "年代"
            Case "TCON"
                str1 = "类型"
            Case "COMM"
                str1 = "备注"
                str2 = Trim(Mid(str2,4)) '前4个字符为语言代码(3)+空格(1).chi为中文,eng为自然语言
            Case Else
                str1 = UCase(i)
        End Select
        str3 = str3 & str1 & vbTab & str2 & vbLf
    Next
    WScript.Echo  str3
    Set objDictionary = Nothing
    Set objStream = Nothing
End Sub

'**********************************************************************************
'2进制转换为字符串
'**********************************************************************************
Function GetStr(Bin)
    For I = 1 To LenB(Bin)
        clow=MidB(Bin,I,1)
        If ASCB(clow)<128 Then
            If AscB(clow) = 0 Then 
                Str = Str & Space(1)
            Else
                Str = Str & Chr(ASCB(clow))
            End If
        Else
            I=I+1
            If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
        End If
    Next
    GetStr = Str
End Function

'**********************************************************************************
'获得文件名
'**********************************************************************************
Function GetFileName()

If WScript.Arguments.Count < 1 Then 
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "Mp3 File|*.mp3|All Files|*.*"
        objDialog.InitialDir = ""
        objDialog.ShowOpen
        GetFileName = objDialog.FileName        
    Set objDialog = Nothing
Else 
    GetFileName = WScript.Arguments(0)
End If

End Function

保存为vbs文件，然后把 mp3文件拖上去就行了，或者直接双击打开再选择文件。 p.s:主要是想到以前有个帖子问如何从cmd下读取mp3标题，然后用读到的标题改mp3的文件名，记得当时没有人给出答案，现在终于可以用cmd+vbs而不用第三方东东来解决了。

作者: electronixtar 时间: 2006-10-15 10:51

我也贴一个，51js上高人给的代码可以读取 ID-3 的 tag，支持所有 Windows Media Player 支持的格式的信息可以修改mp3文件的 tag

Dim objArgs, iFilename, iMusicName, iMusicPtr, iSinGerName, iSpecialName, iSpecialTime, istrInfo
Set objArgs = WScript.Arguments
iFilename = objArgs(0)
Set objArgs = Nothing

iMusicName = "夜曲 - a306.com" 
iMusicPtr = "a306.com" 
iSinGerName = "周杰伦 - a306.com" 
iSpecialName = "十一月的萧邦 - a306.com" 
iSpecialTime = Now()
istrInfo = "http://www.a306.com"

Call SetWmaTag(iFilename, iMusicName, iMusicPtr, iSinGerName, iSpecialName, iSpecialTime, istrInfo)

'修改wma标签

Sub SetWmaTag(Filename, MusicName, MusicPtr, SinGerName, SpecialName, SpecialTime, strInfo)
    On Error GoTo 0
    Dim Player1
    Set Player1 = CreateObject("WMPlayer.OCX.7")
    Player1.settings.autoStart = False
    Player1.settings.mute = True
    Player1.Url = Filename
    Player1.Controls.stop
    
    Player1.currentMedia.setItemInfo "Title", MusicName & " " & strInfo
    Player1.currentMedia.setItemInfo "Artist", SinGerName & " " & strInfo
    Player1.currentMedia.setItemInfo "Album", SpecialName & " " & strInfo
    Player1.currentMedia.setItemInfo "Writer", strInfo
    Player1.currentMedia.setItemInfo "Composer", strInfo
    Player1.currentMedia.setItemInfo "Lyrics", strInfo
    Player1.currentMedia.setItemInfo "Description", strInfo
    Player1.currentMedia.setItemInfo "WM/WMADRCPeakReference", strInfo
    Player1.currentMedia.setItemInfo "WM/WMADRCAverageReference", strInfo
    Player1.currentMedia.setItemInfo "WM/Year", SpecialTime & " " & strInfo
    'Player1.currentMedia.setItemInfo "WM/PromotionURL", strInfo
    Player1.currentMedia.setItemInfo "WM/Track", strInfo
    'Player1.currentMedia.setItemInfo "WM/AlbumCoverURL", strInfo
    Player1.currentMedia.setItemInfo "WM/Publisher", strInfo
    Player1.currentMedia.setItemInfo "WM/Publisher", strInfo
    Player1.currentMedia.setItemInfo "WM/ContentGroupDescription", strInfo
    Player1.currentMedia.setItemInfo "WM/SubTitle", strInfo
    Player1.currentMedia.setItemInfo "WM/AlbumTitle", SpecialName & " " & strInfo
    Player1.currentMedia.setItemInfo "WM/OriginalAlbumTitle", strInfo
    Player1.currentMedia.setItemInfo "WM/Genre", strInfo
    Player1.currentMedia.setItemInfo "WM/Mood", strInfo
    Player1.currentMedia.setItemInfo "WM/TrackNumber", MusicPtr
    Player1.currentMedia.setItemInfo "WM/PartOfSet", SinGerName & " " & strInfo
    Player1.currentMedia.setItemInfo "WM/AlbumArtist", strInfo
    Player1.currentMedia.setItemInfo "WM/Conductor", strInfo
    Player1.currentMedia.setItemInfo "WM/OriginalArtist", strInfo
    Player1.currentMedia.setItemInfo "WM/Writer", strInfo
    Player1.currentMedia.setItemInfo "WM/OriginalLyricist", strInfo
    Player1.currentMedia.setItemInfo "WM/Composer", strInfo
    Player1.currentMedia.setItemInfo "WM/Lyrics", strInfo
    Set Player1 = Nothing
End Sub

[ Last edited by electronixtar on 2006-11-27 at 02:42 AM ]

作者: electronixtar 时间: 2006-11-27 05:10

发一个更猛的 http://www.visualbasicscript.com/m_25855/mpage_1/key_mp3/tm.htm

Option Explicit

'Const ForReading

Dim MyString(127)
Dim oFile
Dim sStartFolder
Dim strNewName
Dim sBuffer
Dim MPfile
Dim strArtist
Dim strSong
Dim dstFolder
Dim sBaseMP3
Dim Fso
Dim oFolder
Dim i
Dim x
Dim c
Dim title
Dim Artist
Dim Album
Dim albumyear
dim comment
Dim genre
Dim DoThing
Dim Flog
Dim retFname
Dim retFileName
Dim retFldr
Dim strTempName
Dim Count : Count = 0

Dim WshShell : set WshShell = WScript.CreateObject("WScript.Shell")
Set Fso = CreateObject("Scripting.FileSystemObject")

sBaseMP3 = "D:\testing"
sStartFolder  = "D:\Testing\MP3\"

Set oFolder = Fso.GetFolder(sStartFolder)
For each oFile in oFolder.Files
        If ucase(Right(oFile.name, 4)) = ".MP3" then
                Call GetMP3(oFile)
                Count = Count + 1
        End if
Next

Msgbox Count & " " & "Files have been processed"

Sub GetMP3(string)
Dim Seperator, Songlength
DoThing = False
Set MpFile = Fso.OpenTextFile(String, 1, False, 0)
sBuffer = MpFile.ReadAll

For i = 0 To 124
        MyString(i) = Chr(Asc(right(sBuffer, i + 1)))
Next

For x = 0 To 124
        c = 124 - x
        If c > 94 and c <= 127 Then title = title & mystring(c)
        If c > 64 and c <= 94 Then artist = artist & mystring(c)
'Commented out.  If you want to use the information below then
uncomment it.
'       If c > 34 and c <= 64 Then album = album & mystring(c)
'       If c > 30 and c <= 34 Then albumyear = albumyear & mystring(c)
'       If c > 0 and c <= 30 Then comment = comment & mystring(c)
'       If c = 0 then genre = mystring(c)
Next

MPFile.close

strArtist = Replace(Artist, Chr(0), "")
                strArtist = Replace(strArtist,"."," ")
                strArtist = Replace(strArtist,"(","")
                strArtist = Replace(strArtist,")","")
                strArtist = Replace(strArtist,"[","")
                strArtist = Replace(strArtist,"]","")
                strArtist = Replace(strArtist,"!","")
                strArtist = Replace(strArtist,"/","_")
                strArtist = Replace(strArtist,"\","_")
                strArtist = trim(strArtist)

strSong = Replace(title, Chr(0), "")
                strSong = Replace(strSong,"[","(")
                strSong = Replace(strSong,"]",")")
                strSong = Replace(strSong,"/","_")
                strSong = Replace(strSong,"\","_")
                strSong = trim(strSong)

'START POSSIBLE LOOP
retFname = Msgbox("Original name:" & vbtab & oFile.name & vbCrLf _
                                 & "New name:" & vbtab & "[" & strArtist & " - " & strSong & ".mp3" & "]" & vbcr _
                                 & "Artist:" & vbTab & "[" & strArtist & "]" & vbcr _
                                 & "Song:" & vbTab & "[" & strSong & "]" & vbCr _
                                 & vbCr & "Is the new name correct?  If not click NO and" & vbCr _
                                 & "when prompted, type in new name.", vbYesNoCancel, "Rename File")

        If retFname = vbYes then
                strNewName = strArtist & " - " & strSong & ".mp3"
        ElseIf retFname = vbNo then
                strTempName = InputBox("Type in the new name of the MP3.  If the new name is not known hit enter to keep original name" _
                & vbcrlf & "Old file name:" & vbTab & oFile.Name)
                If strTempName = "" then
                        retTempFname = msgbox("You have chosen" & " " & oFile.Name & " " & "to be the name of the file.  Is this correct?",vbYesNo)
                                If retTempFname = vbYes then
                                        strNewName = oFile.Name
                                ElseIf retTempFname = vbNo then
                                        'POSSIBLE LOOP
                                End if
                ElseIf ucase(Right(strTempname, 4)) <> ".MP3" then
                        strNewName = strTempName & ".mp3"
                                seperator = InstrRev(strTempName,"-") 'count left to the first occurance of "-"
                                if (seperator >= 1) then                             'if the seperator exists split into artist (folderName) and song (trackName)
                                        strArtist = Trim(Left(strTempName,seperator - 1)) 'seperate artist
                                        songLength= (Len(strTempName)- seperator)'work out chr length of song
                                        strSong = Trim(right(strTempName,songLength))'seperate song
                                End if
                    msgbox  "New name:" & vbTab & strNewName & vbCr _
                   & "Artist:" & vbTab & strArtist & vbcr _
                   & "Song:" & vbTab & strSong
               End if
        ElseIf retFname = vbCancel then
            wscript.Quit
        End if
'END POSSIBLE LOOP

WriteToLog("Original name" & vbtab & oFile.Name)
WriteToLog("Artist" & vbTab & vbtab & strArtist)
WriteToLog("Title" & vbTab & vbTab & strSong)
WriteToLog("New name" & vbTab & vbtab & strNewName)
WriteToLog("")
On Error Resume Next

        If not Fso.FolderExists(sBaseMP3 & "\" & strArtist) then
                dstFolder = Fso.CreateFolder(sBaseMP3 & "\" & strArtist)
        Else
                dstFolder = sBaseMP3 & "\" & strArtist
        End if

'This error checking might not be needed.
If Err.Number > 0 then
        Dothing = False
        Msgbox err.number & vbtab & ofile.name
End if
On Error goto 0

                If not Fso.FileExists(dstFolder & "\" & strNewName) Then
                        Fso.MoveFile oFile.Path, dstFolder & "\" & strNewName
                Else
                        'DO SOME TYPE OF LOOP HERE.  POSSIBLE SUB CALL TO RENAME FILE AS NEEDED ADDING TO THE (1).
                        'right now this will fail if a file is already named (1)strnewname.
                        Fso.MoveFile oFile.Path, dstFolder & "\" & "(1)" & strNewName
                End If

'Clean up
Set MpFile = Nothing
MyString(i) = ""
sBuffer = ""
Title = ""
Artist = ""
strNewName = ""
strArtist = ""
strSong = ""
'album = ""
'albumyear = ""
'comment = ""
'genre = ""
End Sub

Sub WriteToLog(string)
    If not Fso.FileExists(sStartFolder & "MP3.Log") Then
        Set fLog = Fso.CreateTextFile(sStartFolder & "mp3.log", TRUE)
        fLog.Close
    End if
    Set fLog = Fso.OpenTextFile(sStartFolder & "mp3.log", 8)
    fLog.WriteLine(string)
    fLog.Close
End Sub

作者: ccwan 时间: 2006-11-27 05:12

酷啊！顶了再看！

作者: electronixtar 时间: 2006-11-27 05:14

Another one: http://groups.google.com/group/microsoft.public.scripting.wsh/browse_thread/thread/8193e762a91edb45/e615432fab757214?q=MP3&rnum=1#e615432fab757214 思路都是一样的

const adTypeBinary = 1
const adModeReadWrite = 3

  dim Stream
  dim strTag, strSongName, strArtist, strAlbum, strYear, _
      strComment, strGenre, strFile

  'Specify the folder to iterate through, displaying all the MP3s
folder = "D:\Testing\MP3\"

  'Grab the folder information
  Dim FSO', Folder, File
  Set FSO = CreateObject("Scripting.fileSystemObject")
  Set Folder = FSO.GetFolder(folder)

set stream = createobject("adodb.stream")
Stream.Type = adTypeBinary
stream.mode = adModeReadWrite

  'Loop through the files in the folder
  For Each File in Folder.Files

        Stream.Open
    Stream.LoadFromFile File.Path

    'Read the last 128 bytes
    Stream.Position =  Stream.size - 128

    'Read the ID3 v1 tag info
    strTag = ConvertBin(Stream.Read(3))
    if ucase(strTag) = "TAG" then
      strSongName = ConvertBin(Stream.Read(30))
      strArtist = ConvertBin(Stream.Read(30))
      strAlbum = ConvertBin(Stream.Read(30))
      strYear = ConvertBin(Stream.Read(4))
      strComment = ConvertBin(Stream.Read(30))
    end if

WriteToLog("Name" & vbTab & File.Name) & vbcrlf
WriteToLog("Artist" & vbtab & StrArtist) & vbcrlf
WriteToLog("track" & vbTab & strSongName) & vbcrlf
WriteToLog("Album" & vbtab & strAlbum) & vbcrlf
WriteToLog("Year" & vbtab & strYear) & vbcrlf
WriteToLog("Comment" & vbtab & strComment) & vbcrlf
WriteToLog("") & vbcrlf

'OR
'msg = msg & "Name" & vbTab & File.Name & vbcrlf & _
'          & "Artist" & vbtab & StrArtist & vbcrlf _
'          & "track" & vbTab & strSongName & vbcrlf _
'          & "Album" & vbtab & strAlbum & vbcrlf _
'      & "Year" & vbtab & strYear & vbcrlf _
'      & "Comment" & vbtab & strComment & vbcrlf _
'      & ("") & vbcrlf

'OR
'          msgbox  "Name" & vbTab & File.Name & vbcrlf & _
'          & "Artist" & vbtab & StrArtist & vbcrlf _
'          & "track" & vbTab & strSongName & vbcrlf _
'          & "Album" & vbtab & strAlbum & vbcrlf _
'      & "Year" & vbtab & strYear & vbcrlf _
'      & "Comment" & vbtab & strComment & vbcrlf _
'      & ("") & vbcrlf

        Stream.Close

  Next
  Set Stream = Nothing    'Clean up...

Msgbox "DONE"

  Function ConvertBin(Binary)
  'This function converts a binary byte into an ASCII byte.
    for i = 1 to LenB(Binary)
      strChar = chr(AscB(MidB(Binary,i,1)))
      ConvertBin = ConvertBin & strChar
    Next
  End Function

Sub WriteToLog(string)
    If not Fso.FileExists("c:\MP3.Log") Then
        Set fLog = Fso.CreateTextFile("c:\mp3.log", TRUE)
        fLog.Close
    End if
    Set fLog = Fso.OpenTextFile("c:\mp3.log", 8)
    fLog.WriteLine(string)
    fLog.Close
End Sub

作者: electronixtar 时间: 2006-11-27 05:17

最 cool 的方法：（使用 shell.application，也就是资源管理器里那种） http://groups.google.com/group/microsoft.public.scripting.wsh/browse_thread/thread/aa8884c312187845/d3d98ba2eff257fe?lnk=gst&q=MP3+shell.application&rnum=1#d3d98ba2eff257fe

var sh = new ActiveXObject("Shell.Application");
var d = sh.NameSpace(0); // Desktop-Folder

var s = 'Column-IDs for GetDetailsOf ';
s    += '(Default-Folder):\r\n';

var i = -1;

while (++i<101) { /* scan cols from 0 to 100 */
  var col_name = d.GetDetailsOf(null,i);
  if (col_name.length)
    s += '\r\n' + i + ':\t' + col_name;
}

WScript.Echo (s);

作者: electronixtar 时间: 2006-11-27 05:18

又感觉自己的 vbs功夫不够啊，国外的牛人太多了。

作者: 3742668 时间: 2006-11-27 13:35

Re electronixtar: 关于2F的代码，曾经于microsoft上看到过相关用法，不过拒microsoft官方说:只是更改在WMPlayer播放中的信息，而不是更改文件本身的信息。关于3F的代码，太乱了，粗略看了一下，算法很不成熟，貌似老外中的菜鸟。关于5F的代码，它应该针对的是id3v1格式的文件头，这种文件头现在用得少了，而且算法很简单，只要读取并转换最后128字节的内容就行了。关于1F的代码，目前已经发现bug，原因是由于各种不同的播放器可能对mp3文件头做不同的修改，例如winamp在每个帧字段前加一个 '$0' 不说,单单又只在URL字段前加两个 '$0' !? ，至于foobar也存在格式不规范的问题。由于出现了各种版本不同的id3v2格式，所以这个bug看来是难以解决了，除非针对每种格式写不同的函数。关于6F的方法，确实比较独特，不过是js版的，而且并不能显示出指定音频文件的相关信息，所以参照它写了个vbs脚本，可以指定文件,支持参数，拖放:

    arrFile = MyGetFile()
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.NameSpace(arrFile(1) + "\")
Set oFile = oDir.ParseName(arrFile(0))
For i = 0 To 100
    sTmp = oDir.GetDetailsOf(,i) + vbTab
    If sTmp = vbTab Then Exit For
    sPrint = sPrint + vbCrLf + sTmp + vbTab + _
                 oDir.GetDetailsOf(oFile,i)
Next
WScript.Echo sPrint

Set oFile = Nothing
Set oDir = Nothing
Set oShell = Nothing

'***********************************************************************************
'获得要操作的文件,返回一个包含文件名和路径的数组
'***********************************************************************************
Function MyGetFile()

On Error Resume Next
Dim strFile,objFso,objFile
    If WScript.Arguments.Count < 1 Then
        Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "mp3 文件|*.mp3|wma 文件|*.wma|wav 文件|*.wav|所有 文件|*.*"
        objDialog.ShowOpen
        strFile = objDialog.FileName
        Set objDialog = Nothing
    Else
        strFile = WScript.Arguments(0)
    end if
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile = objFso.GetFile(strFile)
    If Err Then 
        If Err.Number = 5 Then WScript.Quit
        WScript.Echo Err.Description 
        Err.Clear
        WScript.Quit
    Else
        MyGetFile = Array(objFile.Name,objFile.ParentFolder)
    End If
    
Set objFile = Nothing
Set objFso = Nothing

End Function

作者: electronixtar 时间: 2006-11-27 23:38

为了3742668，再次顶～

只是更改在WMPlayer播放中的信息，而不是更改文件本身的信息

看MSDN可以发现，有些属性是改 Media Player 媒体库的信息，有的是改 mp3文件本身的属性，比如说 title，我试了下，的确改的是 mp3 文件本身

作者: estar 时间: 2007-4-21 08:40

今天又逛到这里来啦，签名闪人。

作者: weilong888 时间: 2007-4-21 09:25

虽然不是很懂，看看还是很过瘾的。

作者: rockylee 时间: 2008-12-24 20:34

怎么在我的电脑上老运行不了。