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

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

&&相信大家都有过这样的经历,从网上批量下歌曲时得到的文件名并不是我们所想要的歌手+歌曲名格式,
而是一堆序列号或随机生成的字符串文件名,如001.m3、kjfdakfjfsa.wma。怎么办?其实无论文件名
怎么乱,只要它还是一个标准的音频文件,在其文件中就会含有歌手和歌名的信息,这个我们右键音频文件
的属性摘要就能看到。既然,这些信息存在于文件之中,那么能不能用什么方法获取出来并格式化地重命名
我们的音频文件呢?YES,下面的代码就是为解决这个问题而生的:
  1. Dim PathFile, Path, File, Ext
  2. If WScript.Arguments.Count = 0 Then
  3.   GetFile
  4.   Else
  5.   PathFile = WScript.Arguments(0)
  6. End If
  7. Dim objFSO
  8. Set objFSO = CreateObject("Scripting.FileSystemObject")
  9. Path = objFSO.GetFile(pathfile).ParentFolder & "\"
  10. File = objFSO.GetFile(pathfile).Name
  11. Ext = "." & objFSO.GetExtensionName(PathFile)
  12. Dim objSHELL
  13. Set objSHELL = CreateObject("Shell.Application")
  14. Dim objPath, objFile, objName, Arlt, Name
  15. Set objPath = objSHELL.NameSpace(Path)
  16. Set objFile = objPath.ParseName(File)
  17. For i = 0 To 50
  18.   If objPath.GetDetailsOf(,i) = "作者" Then Arlt = objPath.GetDetailsOf(objFile, i)
  19.   If objPath.GetDetailsOf(,i) = "标题" Then Name = objPath.GetDetailsOf(objFile, i)
  20. Next
  21. If Arlt <> "" And Name <> "" Then
  22.   objFSO.CopyFile PathFile, Path & Arlt & "_" & Name & Ext, True
  23.   objFSO.DeleteFile PathFile
  24. End If
  25. Set objFSO = Nothing
  26. Set objSHELL = Nothing
  27. Function GetFile
  28.   Dim objDIA
  29.   Set objDIA = CreateObject("Useraccounts.Commondialog")
  30.   objDIA.Filter = "mp3文件|*.mp3|wma文件|*.wma|wav文件|*.wav|所有文件|*.*|"
  31.   objDIA.InitialDir = "\.\"
  32.   objDIA.ShowOpen
  33.   PathFile = objDIA.FileName
  34.   Set objDIA = Nothing  
  35. End Function
复制代码
说明:
    1、在XP下代码支持双击选择文件类型和文件以及拖放文件,WIN7下仅支持文件拖放(蛋疼)
    2、重命名的格式为“歌手_歌名”,请根据自己需要修改
    3、本人暂时只测试了mp3、wma、wav文件,欢迎测试
    4、暂不支持批量拖入
1

评分人数

    • broly: 感谢分享技术 + 1
***共同提高***

回复 1# batman
Win7应该是不提供Useraccounts.CommonDialog,选择文件我一般都是用的:
  1. function BrowseForFile()
  2.     dim shell : set shell = CreateObject("WScript.Shell")
  3.     dim fso : set fso = CreateObject("Scripting.FileSystemObject")
  4.     dim tempFolder : set tempFolder = fso.GetSpecialFolder(2)
  5.     dim tempName : tempName = fso.GetTempName()
  6.     dim tempFile : set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
  7.     tempFile.Write _
  8.     "<html>" & _
  9.     "<head>" & _
  10.     "<title>Browse</title>" & _
  11.     "</head>" & _
  12.     "<body>" & _
  13.     "<input type='file' id='f' />" & _
  14.     "<script type='text/javascript'>" & _
  15.     "var f = document.getElementById('f');" & _
  16.     "f.click();" & _
  17.     "var shell = new ActiveXObject('WScript.Shell');" & _
  18.     "shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp', f.value);" & _
  19.     "window.close();" & _
  20.     "</script>" & _
  21.     "</body>" & _
  22.     "</html>"
  23.     tempFile.Close
  24.     shell.Run tempFolder & "\" & tempName & ".hta", 0, true
  25.     BrowseForFile = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
  26.     shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
  27. end function
复制代码
1

评分人数

    • broly: 感谢分享技术 + 1
看得多说得多,远比不上写得多。

TOP

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

我来重复造一下轮子:
音乐文件信息修正工具 - 修正ID3、文件名    by Yu2n@qq.com

环境:windows7 x64

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

使用:
要使用本程序,请用鼠标拖放一个或多个音乐文件到本程序图标上。
提示:你得保证文件名与ID3中,至少有一个信息是正确的。(想要自动的话,可要加上联网查找+用户选择,不想做那么麻烦的了)
  1. ''''音乐文件信息修正工具 - 修正ID3、文件名    by Yu2n@qq.com
  2. ''''http://www.bathome.net/thread-25671-1-1.html
  3. '' 生成参数列表,等待传入命令行
  4. Dim i, sArgs
  5. For i = 1 To WScript.Arguments.Count
  6.     sArgs = sArgs & " " & """" & WScript.Arguments(i-1) & """"
  7. Next
  8. ' 以命令提示符环境运行(保留参数)
  9. Dim WH
  10. Set WH = GetObject("Winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("Select * from Win32_DesktopMonitor")
  11. For Each aWH in WH
  12.     TW = Int(aWH.ScreenWidth/8)
  13. Next
  14. Set WH = Nothing
  15. If TW <= 0 Then
  16.     TW =128
  17. End If
  18. If (Lcase(Right(Wscript.FullName,11)) = "wscript.exe") Then
  19.     CreateObject("WScript.Shell").Run( _
  20.         "%Comspec% /c " & Chr(34) & "mode con cols=" & TW & "&Title 音乐文件信息修正工具 - 修正ID3、文件名    by Yu2n@qq.com &&Cscript.exe //NoLogo  " & _
  21.         Chr(34) & Wscript.ScriptFullName & Chr(34) & sArgs & Chr(34) & "&pause"),3
  22.         Wscript.Quit
  23. End If
  24. '' 获取输入
  25. Dim sFilePath, sFileFolder, sFileName, sFileExt
  26. If WScript.Arguments.Count = 0 Then
  27.     WScript.Echo "提示:错误的启动方式。要使用本程序,请用鼠标拖放一个或多个音乐文件到本程序图标上……"
  28.     WScript.Quit
  29. Else
  30.     Dim sMsg
  31.     For i = 0 To WScript.Arguments.Count - 1
  32.         sFilePath = WScript.Arguments(i)
  33.         
  34.         On Error Resume Next
  35.         
  36.         Call CorrectionsID3(sFilePath)
  37.         
  38.         If Err.Number <> 0 then
  39.             WScript.Echo "        错误代号 " & Err.Number & "," & Err.Description & "。"
  40.         End If
  41.         
  42.         On Error Goto 0
  43.         
  44.         WScript.Echo vbCr
  45.     Next
  46. End If
  47. '' 修正音乐文件ID3与文件名
  48. Function CorrectionsID3(ByVal sFilePath)
  49.    
  50.     '' 获取文件信息
  51.     Dim objFSO
  52.     Set objFSO = CreateObject("Scripting.FileSystemObject")
  53.     If Not objFSO.FileExists(sFilePath) Then Exit Function          '''' 文件不存在时,退出函数
  54.     sFileFolder = objFSO.GetFile(sFilePath).ParentFolder & "\"      '''' 取得文件名、拓展名
  55.     sFileExt = "." & objFSO.GetExtensionName(sFilePath)
  56.     sFileName = objFSO.GetFile(sFilePath).Name
  57.     WScript.Echo "文 件:" & sFileName
  58.    
  59.     If sFileExt = "." Then
  60.         sFileExt = ""
  61.         WScript.Echo "[失败]  无修正。  不支持该文件格式。"
  62.         Exit Function
  63.     Else
  64.         sFileName = Left(sFileName, Len(sFileName) - Len(sFileExt))
  65.     End If
  66.    
  67.     '' 以文件名为准,生成临时ID3信息
  68.     Dim sFileArtist, sFileTitle
  69.     If InStr(1, sFileName, "-", vbTextCompare) > 0 Then
  70.         sFileArtist = Trim(Mid(sFileName, 1, InStr(sFileName, "-") - 1))
  71.         sFileTitle = Trim(Mid(sFileName, InStr(sFileName, "-") + 1))
  72.     End If
  73.     If sFileArtist = "" Or sFileTitle = "" Then
  74.         sFileArtist = "" :   sFileTitle = ""
  75.     End If
  76.     '' 取得当前文件的ID3信息:http://techsupt.winbatch.com/webcgi/webbatch.exe?techsupt/nftechsupt.web+WinBatch/OLE~COM~ADO~CDO~ADSI~LDAP+Get~Audio~File~Information.txt
  77.     Dim objWMP, objSong, sID3Artist, sID3Title
  78.     Set objWMP = CreateObject("WMPlayer.OCX")
  79.     Set objSong = objWMP.newMedia(sFilePath)
  80.     sID3Artist = Trim(objSong.GetItemInfo("Artist"))
  81.     sID3Title = Trim(objSong.GetItemInfo("Title"))
  82.     sDuration = objSong.GetItemInfo("Duration")
  83.     If sDuration = "" Then
  84.         WScript.Echo "[失败]  无修正。  不支持该文件格式。"
  85.         Exit Function     '''' 音乐长度,无此属性说明不支持修改ID3,退出函数
  86.     End If
  87.     If sID3Artist <> "" Then
  88.         sID3Artist = Replace(sID3Artist, "&", ", ", vbTextCompare, -1, 1)   '''' 修正符号号
  89.         sID3Artist = Replace(sID3Artist, "?", "", vbTextCompare, -1, 1)     '''' 修正乱码
  90.         WScript.Echo "        艺术家:" & sID3Artist
  91.     End If
  92.     If sID3Title <> "" Then
  93.         sID3Title = Replace(sID3Title, "?", "", vbTextCompare, -1, 1)
  94.         WScript.Echo "        标 题:" & sID3Title
  95.     End If
  96.     If sID3Artist = "" Or sID3Title = "" Then
  97.         sID3Artist = "" :   sID3Title = ""
  98.     End If
  99.    
  100.     '''' 信息不全时
  101.     If sFileArtist = "" And sFileTitle = "" And _
  102.             sID3Artist = "" And sID3Title = "" Then
  103.         WScript.Echo "[失败]  无修正。  信息不全。"
  104.         Exit Function
  105.     End If
  106.         
  107.     '' '' 非完全匹配、信息冲突
  108.     If Not (sFileArtist = sID3Artist And sFileTitle = sID3Title) Then
  109.         
  110.         '' 信息冲突时,提示
  111.         If sFileArtist <> "" And sFileTitle <> "" And _
  112.                 sID3Artist <> "" And sID3Title <> "" Then
  113.             sAsk = " 文件名称 “" & sFileName & sFileExt & "” 与 ID3 信息冲突,请选择:" & vbCrLf & vbCrLf & _
  114.                     " [ 是(Y) ] 将文件改名为:"  & vbCrLf & _
  115.                     "     " & sID3Artist & " - " & sID3Title & sFileExt & vbCrLf & vbCrLf & _
  116.                     " [ 否(N) ] 修改文件的ID3信息为:"   & vbCrLf & _
  117.                     "     作者:" & sFileArtist & vbCrLf & _
  118.                     "     标题:" & sFileTitle & vbCrLf & vbCrLf & _
  119.                     " [ 取消 ] 不作变更"
  120.             WScript.Echo "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
  121.             WScript.Echo sAsk
  122.             WScript.Echo "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
  123.             Select Case MsgBox(sAsk, vbYesNoCancel, "音乐文件信息修正工具 - 修正ID3、文件名")
  124.                 Case vbYes
  125.                     sFileArtist = ""
  126.                     sFileTitle = ""
  127.                 Case vbNo
  128.                     sID3Artist = ""
  129.                     sID3Title = ""
  130.                 Case Else
  131.                     Exit Function
  132.             End Select
  133.         End If
  134.         
  135.     End If
  136.     '' 以文件名为基准,修改ID3信息
  137.     If (sFileArtist <> "" And sFileTitle <> "") And _
  138.             (sID3Artist = "" Or sID3Title = "") Then
  139.         '' 更新 ID3
  140.         sID3Artist = sFileArtist
  141.         sID3Title = sFileTitle
  142.         With objSong
  143.             '.setItemInfo "author", Trim(sID3Artist)
  144.             .setItemInfo "artist", Trim(sID3Artist)
  145.             .setItemInfo "title", Trim(sID3Title)
  146.             ''.setItemInfo "WM/AlbumTitle", ""  '"专辑标题"
  147.             ''.setItemInfo "WM/Genre", ""       '"流派"
  148.             ''.setItemInfo "WM/Year", ""        '"发行年"
  149.             ''.setItemInfo "WM/TrackNumber", 1  'number    '音轨只能是数字
  150.             ''.setItemInfo "WM/Lyrics", ""      '"歌词"
  151.             ''.setItemInfo "Description", "yu2n@qq.com  " & Now()    '"备注"
  152.         End With
  153.         WScript.Echo "[成功]  已修正。  艺术家:" & Trim(objSong.GetItemInfo("Artist"))
  154.         WScript.Echo "[成功]  已修正。  标 题:" & Trim(objSong.GetItemInfo("Title"))
  155.     End If
  156.     '' 添加备注,结束 objSong, objWMP ,更新 ID3。(必须在FSO移动操作之前)
  157.     objSong.setItemInfo "Description", "Yu2n@qq.com corrections ID3 information on " & Now()
  158.     Set objSong = Nothing
  159.     Set objWMP = Nothing
  160.     '' 以新的ID3为基准,重命名文件
  161.     If sID3Artist <> "" And sID3Title <> "" Then
  162.         Dim sFilePath2
  163.         sFilePath2  = sFileFolder & sID3Artist & " - " & sID3Title & sFileExt
  164.         If sFilePath <> sFilePath2 Then
  165.             objFSO.MoveFile sFilePath, sFilePath2
  166.             WScript.Echo "[成功]  已修正。  文件名:" & sID3Artist & " - " & sID3Title & sFileExt & " 。"
  167.         Else
  168.             WScript.Echo "[失败]  无修正。  文件名与ID3信息一致,不作变更。(或该文件部分损坏无法识别)"
  169.         End If
  170.     End If
  171.     Set objFSO = Nothing
  172. End Function
复制代码
一些例子运行结果:
  1. 文 件:5566 - 好久不见.mp3
  2.         艺术家:5566
  3.         标 题:
  4. [成功]  已修正。  艺术家:5566
  5. [成功]  已修正。  标 题:好久不见
  6. [失败]  无修正。  文件名与ID3信息一致,不作变更。(或该文件部分损坏无法识别)
  7. 文 件:073任贤齐-诛仙-我回来(清晰完整版).mp3
  8.        艺术家:073任贤齐
  9.        标 题:我回來
  10. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  11. 文件名称 “073任贤齐-诛仙-我回来(清晰完整版).mp3” 与 ID3 信息冲突,请选择:
  12. [ 是(Y) ] 将文件改名为:
  13.      073任贤齐 - 我回來.mp3
  14. [ 否(N) ] 修改文件的ID3信息为:
  15.      作者:073任贤齐
  16.      标题:诛仙-我回来(清晰完整版)
  17. [ 取消 ] 不作变更
  18. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  19. 文 件:129周慧敏.痴心换情深.mp3
  20.        艺术家:周慧敏---By fifu
  21.        标 题:痴心换情深
  22. [成功]  已修正。  文件名:周慧敏---By fifu - 痴心换情深.mp3 。
  23. 文 件:130陈慧娴-人生何处不相逢(粤).mp3
  24.        艺术家:陈慧娴
  25.        标 题:人生何处不相逢
  26. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  27. 文件名称 “130陈慧娴-人生何处不相逢(粤).mp3” 与 ID3 信息冲突,请选择:
  28. [ 是(Y) ] 将文件改名为:
  29.      陈慧娴 - 人生何处不相逢.mp3
  30. [ 否(N) ] 修改文件的ID3信息为:
  31.      作者:130陈慧娴
  32.      标题:人生何处不相逢(粤)
  33. [ 取消 ] 不作变更
  34. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  35. [成功]  已修正。  文件名:陈慧娴 - 人生何处不相逢.mp3 。
  36. 文 件:164张雨生&张惠妹-最爱的人伤我最深.mp3.mp3
  37.        艺术家:张雨生, 张惠妹
  38.        标 题:最爱的人伤我最深.mp3
  39. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  40. 文件名称 “164张雨生&张惠妹-最爱的人伤我最深.mp3.mp3” 与 ID3 信息冲突,请选择:
  41. [ 是(Y) ] 将文件改名为:
  42.      张雨生, 张惠妹 - 最爱的人伤我最深.mp3.mp3
  43. [ 否(N) ] 修改文件的ID3信息为:
  44.      作者:164张雨生&张惠妹
  45.      标题:最爱的人伤我最深.mp3
  46. [ 取消 ] 不作变更
  47. +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  48.        错误代号 58,文件已存在。
  49. 请按任意键继续. . .
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

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

这个例子比较好:
  1. 文 件:周传雄-男人海洋.mp3
  2.         艺术家:先锋电讯手机连锁
  3.         标 题:先锋电讯手机连锁
  4. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5. 文件名称 “周传雄-男人海洋.mp3” 与 ID3 信息冲突,请选择:
  6. [ 是(Y) ] 将文件改名为:
  7.      先锋电讯手机连锁 - 先锋电讯手机连锁.mp3
  8. [ 否(N) ] 修改文件的ID3信息为:
  9.      作者:周传雄
  10.      标题:男人海洋
  11. [ 取消 ] 不作变更
  12. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  13. [成功]  已修正。  艺术家:周传雄
  14. [成功]  已修正。  标 题:男人海洋
  15. [成功]  已修正。  文件名:周传雄 - 男人海洋.mp3 。
  16. 请按任意键继续. . .
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

返回列表