Rank: 8 Rank: 8

帖子: 2702
积分: 14562
技术: 177
捐助: 630
注册时间: 2008-6-16

1楼 跳转到 » 倒序看帖

字体大小: tT

发表于 2013-8-3 22:35 | 只看该作者

[原创] VBS获取音频文件属性信息并重命名

&&相信大家都有过这样的经历，从网上批量下歌曲时得到的文件名并不是我们所想要的歌手+歌曲名格式，
而是一堆序列号或随机生成的字符串文件名，如001.m3、kjfdakfjfsa.wma。怎么办？其实无论文件名
怎么乱，只要它还是一个标准的音频文件，在其文件中就会含有歌手和歌名的信息，这个我们右键音频文件
的属性摘要就能看到。既然，这些信息存在于文件之中，那么能不能用什么方法获取出来并格式化地重命名
我们的音频文件呢？YES，下面的代码就是为解决这个问题而生的：

Dim PathFile, Path, File, Ext
If WScript.Arguments.Count = 0 Then 
  GetFile
  Else
  PathFile = WScript.Arguments(0)
End If
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Path = objFSO.GetFile(pathfile).ParentFolder & "\"
File = objFSO.GetFile(pathfile).Name
Ext = "." & objFSO.GetExtensionName(PathFile)
Dim objSHELL
Set objSHELL = CreateObject("Shell.Application")
Dim objPath, objFile, objName, Arlt, Name
Set objPath = objSHELL.NameSpace(Path)
Set objFile = objPath.ParseName(File)
For i = 0 To 50
  If objPath.GetDetailsOf(,i) = "作者" Then Arlt = objPath.GetDetailsOf(objFile, i)
  If objPath.GetDetailsOf(,i) = "标题" Then Name = objPath.GetDetailsOf(objFile, i)
Next
If Arlt <> "" And Name <> "" Then 
  objFSO.CopyFile PathFile, Path & Arlt & "_" & Name & Ext, True
  objFSO.DeleteFile PathFile
End If
Set objFSO = Nothing
Set objSHELL = Nothing

Function GetFile
  Dim objDIA
  Set objDIA = CreateObject("Useraccounts.Commondialog")
  objDIA.Filter = "mp3文件|*.mp3|wma文件|*.wma|wav文件|*.wav|所有文件|*.*|"
  objDIA.InitialDir = "\.\"
  objDIA.ShowOpen
  PathFile = objDIA.FileName
  Set objDIA = Nothing  
End Function
复制代码

说明：
1、在XP下代码支持双击选择文件类型和文件以及拖放文件，WIN7下仅支持文件拖放（蛋疼）
2、重命名的格式为“歌手_歌名”，请根据自己需要修改
3、本人暂时只测试了mp3、wma、wav文件，欢迎测试
4、暂不支持批量拖入

1 评分人数

broly: 感谢分享技术 + 1

＊＊＊共同提高＊＊＊

weichenxiehou

上尉

Rank: 5 Rank: 5

帖子: 430
积分: 1298
技术: 83
捐助: 0
注册时间: 2010-10-24

2楼

发表于 2013-8-4 07:17 | 只看该作者

回复 1# batman
Win7应该是不提供Useraccounts.CommonDialog，选择文件我一般都是用的：

function BrowseForFile()
    dim shell : set shell = CreateObject("WScript.Shell")
    dim fso : set fso = CreateObject("Scripting.FileSystemObject")
    dim tempFolder : set tempFolder = fso.GetSpecialFolder(2)
    dim tempName : tempName = fso.GetTempName()
    dim tempFile : set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
    tempFile.Write _
    "<html>" & _
    "<head>" & _
    "<title>Browse</title>" & _
    "</head>" & _
    "<body>" & _
    "<input type='file' id='f' />" & _
    "<script type='text/javascript'>" & _
    "var f = document.getElementById('f');" & _
    "f.click();" & _
    "var shell = new ActiveXObject('WScript.Shell');" & _
    "shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
    "window.close();" & _
    "</script>" & _
    "</body>" & _
    "</html>"
    tempFile.Close
    shell.Run tempFolder & "\" & tempName & ".hta", 0, true
    BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
    shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
end function
复制代码

1 评分人数

broly: 感谢分享技术 + 1

看得多说得多，远比不上写得多。

TOP

yu2n

上尉

Rank: 5 Rank: 5

帖子: 715
积分: 1298
技术: 151
捐助: 0
注册时间: 2012-11-1

3楼

发表于 2013-12-9 01:14 | 只看该作者

本帖最后由 yu2n 于 2015-1-2 21:35 编辑

我来重复造一下轮子：
音乐文件信息修正工具 - 修正ID3、文件名 by Ｙu2n＠qq.com

环境：windows7 x64

功能：
1. 文件名格式 [为] “艺术家 - 标题”，并且ID3中没有时，自动将文件名中的“艺术家”、“标题”填充到ID3中。
2. 文件名格式 [不为] “艺术家 - 标题”，并且ID3中有时，自动将文件改名为“艺术家 - 标题”。
3. 文件名格式 [为] “艺术家 - 标题”，并且ID3中有时，提示用户选择修改。
4. 文件名格式 [不为] “艺术家 - 标题”，并且ID3中没有时，不作修改。

使用：
要使用本程序，请用鼠标拖放一个或多个音乐文件到本程序图标上。
提示：你得保证文件名与ID3中，至少有一个信息是正确的。（想要自动的话，可要加上联网查找+用户选择，不想做那么麻烦的了）

''''音乐文件信息修正工具 - 修正ID3、文件名    by Ｙu2n＠qq.com
''''http://www.bathome.net/thread-25671-1-1.html

'' 生成参数列表，等待传入命令行
Dim i, sArgs
For i = 1 To WScript.Arguments.Count
    sArgs = sArgs & " " & """" & WScript.Arguments(i-1) & """"
Next


' 以命令提示符环境运行(保留参数)
Dim WH
Set WH = GetObject("Winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("Select * from Win32_DesktopMonitor")
For Each aWH in WH
    TW = Int(aWH.ScreenWidth/8)
Next
Set WH = Nothing
If TW <= 0 Then
    TW =128
End If
If (Lcase(Right(Wscript.FullName,11)) = "wscript.exe") Then
    CreateObject("WScript.Shell").Run( _
        "%Comspec% /c " & Chr(34) & "mode con cols=" & TW & "&Title 音乐文件信息修正工具 - 修正ID3、文件名    by Ｙu2n＠qq.com &&Cscript.exe //NoLogo  " & _
        Chr(34) & Wscript.ScriptFullName & Chr(34) & sArgs & Chr(34) & "&pause"),3
        Wscript.Quit
End If


'' 获取输入
Dim sFilePath, sFileFolder, sFileName, sFileExt
If WScript.Arguments.Count = 0 Then 
    WScript.Echo "提示：错误的启动方式。要使用本程序，请用鼠标拖放一个或多个音乐文件到本程序图标上……"
    WScript.Quit
Else
    Dim sMsg
    For i = 0 To WScript.Arguments.Count - 1
        sFilePath = WScript.Arguments(i)
        
        On Error Resume Next 
        
        Call CorrectionsID3(sFilePath)
        
        If Err.Number <> 0 then 
            WScript.Echo "        错误代号 " & Err.Number & "，" & Err.Description & "。"
        End If
        
        On Error Goto 0 
        
        WScript.Echo vbCr
    Next
End If

'' 修正音乐文件ID3与文件名
Function CorrectionsID3(ByVal sFilePath)
    
    '' 获取文件信息
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FileExists(sFilePath) Then Exit Function          '''' 文件不存在时，退出函数
    sFileFolder = objFSO.GetFile(sFilePath).ParentFolder & "\"      '''' 取得文件名、拓展名
    sFileExt = "." & objFSO.GetExtensionName(sFilePath)
    sFileName = objFSO.GetFile(sFilePath).Name

    WScript.Echo "文　件：" & sFileName
    
    If sFileExt = "." Then
        sFileExt = ""
        WScript.Echo "[失败]  无修正。　　不支持该文件格式。"
        Exit Function
    Else
        sFileName = Left(sFileName, Len(sFileName) - Len(sFileExt))
    End If
    

    '' 以文件名为准，生成临时ID3信息
    Dim sFileArtist, sFileTitle
    If InStr(1, sFileName, "-", vbTextCompare) > 0 Then
        sFileArtist = Trim(Mid(sFileName, 1, InStr(sFileName, "-") - 1))
        sFileTitle = Trim(Mid(sFileName, InStr(sFileName, "-") + 1))
    End If
    If sFileArtist = "" Or sFileTitle = "" Then
        sFileArtist = "" :   sFileTitle = ""
    End If

    '' 取得当前文件的ID3信息：http://techsupt.winbatch.com/webcgi/webbatch.exe?techsupt/nftechsupt.web+WinBatch/OLE~COM~ADO~CDO~ADSI~LDAP+Get~Audio~File~Information.txt
    Dim objWMP, objSong, sID3Artist, sID3Title
    Set objWMP = CreateObject("WMPlayer.OCX")
    Set objSong = objWMP.newMedia(sFilePath)
    sID3Artist = Trim(objSong.GetItemInfo("Artist"))
    sID3Title = Trim(objSong.GetItemInfo("Title"))
    sDuration = objSong.GetItemInfo("Duration")
    If sDuration = "" Then
        WScript.Echo "[失败]  无修正。　　不支持该文件格式。"
        Exit Function     '''' 音乐长度，无此属性说明不支持修改ID3，退出函数
    End If
    If sID3Artist <> "" Then
        sID3Artist = Replace(sID3Artist, "&", ", ", vbTextCompare, -1, 1)   '''' 修正符号号
        sID3Artist = Replace(sID3Artist, "?", "", vbTextCompare, -1, 1)     '''' 修正乱码
        WScript.Echo "        艺术家：" & sID3Artist
    End If
    If sID3Title <> "" Then
        sID3Title = Replace(sID3Title, "?", "", vbTextCompare, -1, 1)
        WScript.Echo "        标　题：" & sID3Title
    End If
    If sID3Artist = "" Or sID3Title = "" Then
        sID3Artist = "" :   sID3Title = ""
    End If
    
    '''' 信息不全时
    If sFileArtist = "" And sFileTitle = "" And _
            sID3Artist = "" And sID3Title = "" Then
        WScript.Echo "[失败]  无修正。　　信息不全。"
        Exit Function
    End If
        
    '' '' 非完全匹配、信息冲突
    If Not (sFileArtist = sID3Artist And sFileTitle = sID3Title) Then
        
        '' 信息冲突时，提示
        If sFileArtist <> "" And sFileTitle <> "" And _
                sID3Artist <> "" And sID3Title <> "" Then
            sAsk = " 文件名称 “" & sFileName & sFileExt & "” 与 ID3 信息冲突，请选择：" & vbCrLf & vbCrLf & _
                    " [ 是(Y) ]　将文件改名为："  & vbCrLf & _
                    "　　　　　" & sID3Artist & " - " & sID3Title & sFileExt & vbCrLf & vbCrLf & _
                    " [ 否(N) ]　修改文件的ID3信息为:"   & vbCrLf & _
                    "　　　　　作者：" & sFileArtist & vbCrLf & _
                    "　　　　　标题：" & sFileTitle & vbCrLf & vbCrLf & _
                    " [ 取消 ]　不作变更"
            WScript.Echo "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
            WScript.Echo sAsk
            WScript.Echo "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
            Select Case MsgBox(sAsk, vbYesNoCancel, "音乐文件信息修正工具 - 修正ID3、文件名")
                Case vbYes
                    sFileArtist = ""
                    sFileTitle = ""
                Case vbNo
                    sID3Artist = ""
                    sID3Title = ""
                Case Else
                    Exit Function
            End Select
        End If
        
    End If

    '' 以文件名为基准，修改ID3信息
    If (sFileArtist <> "" And sFileTitle <> "") And _
            (sID3Artist = "" Or sID3Title = "") Then
        '' 更新 ID3
        sID3Artist = sFileArtist
        sID3Title = sFileTitle
        With objSong
            '.setItemInfo "author", Trim(sID3Artist)
            .setItemInfo "artist", Trim(sID3Artist)
            .setItemInfo "title", Trim(sID3Title)
            ''.setItemInfo "WM/AlbumTitle", ""  '"专辑标题"
            ''.setItemInfo "WM/Genre", ""       '"流派"
            ''.setItemInfo "WM/Year", ""        '"发行年"
            ''.setItemInfo "WM/TrackNumber", 1  'number    '音轨只能是数字
            ''.setItemInfo "WM/Lyrics", ""      '"歌词"
            ''.setItemInfo "Description", "yu2n@qq.com  " & Now()    '"备注"
        End With
        WScript.Echo "[成功]  已修正。　　艺术家：" & Trim(objSong.GetItemInfo("Artist"))
        WScript.Echo "[成功]  已修正。　　标　题：" & Trim(objSong.GetItemInfo("Title"))
    End If

    '' 添加备注，结束 objSong, objWMP ，更新 ID3。（必须在FSO移动操作之前）
    objSong.setItemInfo "Description", "Ｙu2n＠qq.com corrections ID3 information on " & Now()
    Set objSong = Nothing
    Set objWMP = Nothing

    '' 以新的ID3为基准，重命名文件
    If sID3Artist <> "" And sID3Title <> "" Then
        Dim sFilePath2
        sFilePath2  = sFileFolder & sID3Artist & " - " & sID3Title & sFileExt
        If sFilePath <> sFilePath2 Then
            objFSO.MoveFile sFilePath, sFilePath2
            WScript.Echo "[成功]  已修正。　　文件名：" & sID3Artist & " - " & sID3Title & sFileExt & " 。"
        Else
            WScript.Echo "[失败]  无修正。　　文件名与ID3信息一致，不作变更。（或该文件部分损坏无法识别）"
        End If
    End If
    Set objFSO = Nothing

End Function
复制代码

一些例子运行结果：

文　件：5566 - 好久不见.mp3
        艺术家：5566
        标　题：
[成功]  已修正。　　艺术家：5566
[成功]  已修正。　　标　题：好久不见
[失败]  无修正。　　文件名与ID3信息一致，不作变更。（或该文件部分损坏无法识别）

文　件：073任贤齐-诛仙-我回来（清晰完整版）.mp3
       艺术家：073任贤齐
       标　题：我回來
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
文件名称 “073任贤齐-诛仙-我回来（清晰完整版）.mp3” 与 ID3 信息冲突，请选择：

[ 是(Y) ]　将文件改名为：
　　　　　073任贤齐 - 我回來.mp3

[ 否(N) ]　修改文件的ID3信息为:
　　　　　作者：073任贤齐
　　　　　标题：诛仙-我回来（清晰完整版）

[ 取消 ]　不作变更
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

文　件：129周慧敏.痴心换情深.mp3
       艺术家：周慧敏---By fifu
       标　题：痴心换情深
[成功]  已修正。　　文件名：周慧敏---By fifu - 痴心换情深.mp3 。

文　件：130陈慧娴-人生何处不相逢(粤).mp3
       艺术家：陈慧娴
       标　题：人生何处不相逢
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
文件名称 “130陈慧娴-人生何处不相逢(粤).mp3” 与 ID3 信息冲突，请选择：

[ 是(Y) ]　将文件改名为：
　　　　　陈慧娴 - 人生何处不相逢.mp3

[ 否(N) ]　修改文件的ID3信息为:
　　　　　作者：130陈慧娴
　　　　　标题：人生何处不相逢(粤)

[ 取消 ]　不作变更
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[成功]  已修正。　　文件名：陈慧娴 - 人生何处不相逢.mp3 。

文　件：164张雨生&张惠妹-最爱的人伤我最深.mp3.mp3
       艺术家：张雨生, 张惠妹
       标　题：最爱的人伤我最深.mp3
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
文件名称 “164张雨生&张惠妹-最爱的人伤我最深.mp3.mp3” 与 ID3 信息冲突，请选择：

[ 是(Y) ]　将文件改名为：
　　　　　张雨生, 张惠妹 - 最爱的人伤我最深.mp3.mp3

[ 否(N) ]　修改文件的ID3信息为:
　　　　　作者：164张雨生&张惠妹
　　　　　标题：最爱的人伤我最深.mp3

[ 取消 ]　不作变更
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       错误代号 58，文件已存在。

请按任意键继续. . .
复制代码

『千江有水千江月』千江有水，月映千江；万里无云，万里青天。 http://yu2n.qiniudn.com/

TOP

yu2n

上尉

Rank: 5 Rank: 5

帖子: 715
积分: 1298
技术: 151
捐助: 0
注册时间: 2012-11-1

4楼

发表于 2013-12-9 01:19 | 只看该作者

本帖最后由 yu2n 于 2015-1-2 21:36 编辑

这个例子比较好：

文　件：周传雄-男人海洋.mp3
        艺术家：先锋电讯手机连锁
        标　题：先锋电讯手机连锁
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 文件名称 “周传雄-男人海洋.mp3” 与 ID3 信息冲突，请选择：

 [ 是(Y) ]　将文件改名为：
　　　　　先锋电讯手机连锁 - 先锋电讯手机连锁.mp3

 [ 否(N) ]　修改文件的ID3信息为:
　　　　　作者：周传雄
　　　　　标题：男人海洋

 [ 取消 ]　不作变更
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[成功]  已修正。　　艺术家：周传雄
[成功]  已修正。　　标　题：男人海洋
[成功]  已修正。　　文件名：周传雄 - 男人海洋.mp3 。

请按任意键继续. . .
复制代码

『千江有水千江月』千江有水，月映千江；万里无云，万里青天。 http://yu2n.qiniudn.com/

TOP

返回列表

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

[原创] VBS获取音频文件属性信息并重命名

[收藏此主题] [关注此主题的新回复]

[通过 QQ、MSN 分享给朋友]