中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名：www.cn-dos.net 论坛域名：www.cn-dos.net/forum
DOS，代表着自由开放与发展，我们努力起来，学习FreeDOS和Linux的自由开放与GNU精神，共同创造和发展美好的自由与GNU GPL世界吧！

游客: 注册 | 登录 | 命令行 | 搜索 | 上传 | 帮助 »

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » [原创]用vbs读取mp3文件头(暂时只能读取id3v2)

作者:

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

上一主题 | 下一主题

3742668
荣誉版主

积分 2013
发帖 718
注册 2006-2-18
状态离线

『楼主』: [原创]用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而不用第三方东东来解决了。

2006-10-15 10:44

查看资料发送邮件发短消息网志

编辑帖子

electronixtar
铂金会员

积分 7493
发帖 2672
注册 2005-9-2
状态离线

『第 2 楼』:

我也贴一个，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 ]

C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"

2006-10-15 10:51

查看资料发送邮件发短消息网志

编辑帖子

electronixtar
铂金会员

积分 7493
发帖 2672
注册 2005-9-2
状态离线

『第 3 楼』:

发一个更猛的

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 = trim(strArtist)



strSong = Replace(title, Chr(0), "")

                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 & "" & vbcr _

                                 & "Artist:" & vbTab & "" & vbcr _

                                 & "Song:" & vbTab & "" & 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

2006-11-27 05:10

查看资料发送邮件发短消息网志

编辑帖子

ccwan
金牌会员

积分 2725
发帖 1160
注册 2006-9-23
来自河北廊坊
状态离线

『第 4 楼』:

酷啊！顶了再看！

三人行，必有吾师焉。学然后知不足，教然后知困，然后能自强也。

2006-11-27 05:12

查看资料发送邮件发短消息网志

编辑帖子

electronixtar
铂金会员

积分 7493
发帖 2672
注册 2005-9-2
状态离线

『第 5 楼』:

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

2006-11-27 05:14

查看资料发送邮件发短消息网志

编辑帖子

electronixtar
铂金会员

积分 7493
发帖 2672
注册 2005-9-2
状态离线

『第 6 楼』:

最 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);

2006-11-27 05:17

查看资料发送邮件发短消息网志

编辑帖子

electronixtar
铂金会员

积分 7493
发帖 2672
注册 2005-9-2
状态离线

『第 7 楼』:

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

2006-11-27 05:18

查看资料发送邮件发短消息网志

编辑帖子

3742668
荣誉版主

积分 2013
发帖 718
注册 2006-2-18
状态离线

『第 8 楼』:

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