中国DOS联盟

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

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

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

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

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

    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