VBS音乐歌曲播放器，免安装，无需安装任何支持组件，直接调用系统内置播放组件播放你喜欢的音乐歌曲，vbs技巧进阶

轶软工作室

已于 2025-03-06 14:14:19 修改

阅读量197

点赞数 3

分类专栏：日常命令脚本娱乐游戏文章标签：前端服务器运维

于 2025-02-16 00:00:00 首次发布

本文链接：https://blog.youkuaiyun.com/usenk/article/details/145655471

版权

日常同时被 3 个专栏收录

38 篇文章

订阅专栏

命令脚本

21 篇文章

订阅专栏

娱乐游戏

2 篇文章

订阅专栏

用VBS代码写的一个音乐播放器，简单易用，免安装，直接调用系统播放组件播放你喜欢的音乐歌曲，就是一个【VBS音乐播放器.vbs】的脚本，外观大概就是这个样子了：

目的就是简简单单的播放音乐，后期有空再开发个列表编辑等什么的吧，有兴趣的可以大家也可以自己琢磨一下。VBS音乐播放器V1.vbs 代码奉上：

' 创建 FileSystemObject 和 WMPlayer 对象
Set fso = CreateObject("Scripting.FileSystemObject")
Set player = CreateObject("WMPlayer.OCX")

' 获取当前脚本所在文件夹的路径
Dim currentFolderPath
currentFolderPath = fso.GetParentFolderName(WScript.ScriptFullName)

' 配置文件路径
Dim iniFilePath
iniFilePath = currentFolderPath & "\config.ini" '在当前目录下创建config.ini

' 从配置文件中读取音乐文件夹路径
Dim musicFolderPath
Dim hasValidPath
hasValidPath = False

Do While Not hasValidPath
    If fso.FileExists(iniFilePath) Then
        Dim iniReadFile
        Set iniReadFile = fso.OpenTextFile(iniFilePath, 1) '以只读方式打开文件
        musicFolderPath = iniReadFile.ReadLine() '读取第一行作为音乐文件夹路径
        iniReadFile.Close
    Else
        ' 如果配置文件不存在，提示用户输入音乐文件夹路径
        musicFolderPath = InputBox("请输入音乐文件夹路径", "路径输入")
        If musicFolderPath = "" Then '判断是否取消输入，取消时返回空地址则退出
            WScript.Echo "输入为空，程序退出" ' 弹出提示
            WScript.Quit '直接退出脚本
        End If
    End If

    ' 检查路径是否存在
    If Not fso.FolderExists(musicFolderPath) Then
        WScript.Echo "音乐文件夹路径不存在，请输入正确的音乐文件夹路径。"
        musicFolderPath = InputBox("请输入有效的音乐文件夹路径", "路径输入")
        If musicFolderPath = "" Then '再次判断是否取消输入
            WScript.Echo "输入为空，程序退出" ' 弹出提示
            WScript.Quit '直接退出脚本
        End If
    End If

    ' 检查指定路径下是否有 MP3 文件
    Dim hasMP3Files
    hasMP3Files = False
    If fso.FolderExists(musicFolderPath) Then
        Dim checkFile
        For Each checkFile In fso.GetFolder(musicFolderPath).Files
            If LCase(fso.GetExtensionName(checkFile.Name)) = "mp3" Then
                hasMP3Files = True
                Exit For
            End If
        Next
    End If

    If Not hasMP3Files Then
        WScript.Echo "指定路径下没有 MP3 文件，请重新输入。"
        musicFolderPath = InputBox("请输入包含 MP3 文件的音乐文件夹路径", "路径输入")
        If musicFolderPath = "" Then '再次判断是否取消输入
            WScript.Echo "输入为空，程序退出" ' 弹出提示
            WScript.Quit '直接退出脚本
        End If
    End If

    ' 当路径有效且有 MP3 文件时，写入配置文件
    If fso.FolderExists(musicFolderPath) And hasMP3Files Then
        Dim iniWriteFile
        Set iniWriteFile = fso.CreateTextFile(iniFilePath, True) '创建文件
        iniWriteFile.WriteLine(musicFolderPath)
        iniWriteFile.Close
        hasValidPath = True
    End If
Loop

' 获取文件夹对象
Set musicFolder = fso.GetFolder(musicFolderPath)

' 初始化歌曲数组
Dim songs()
ReDim songs(-1)

' 遍历文件夹，筛选 MP3 文件
Dim file
For Each file In musicFolder.Files
    If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
        ' 将 MP3 文件添加到数组中，动态调整数组大小
        ReDim Preserve songs(UBound(songs) + 1) '确保动态数组大小
        songs(UBound(songs)) = fso.GetBaseName(file.Name) '获取不包含扩展名的文件名
    End If
Next

' 当前歌曲索引
Dim currentSongIndex
currentSongIndex = 0

If UBound(songs) < 0 Then
    WScript.Echo "没有找到 MP3 文件，请检查路径。"
    WScript.Quit
End If

On Error Resume Next ' 错误处理
Do While True
    ' 设置当前播放的歌曲 URL
    player.URL = musicFolderPath & "\" & songs(currentSongIndex) & ".mp3" '拼接完整路径

    ' 设置循环播放模式
    player.settings.setMode "loop", True ' 添加循环播放设置

    ' 等待播放器准备就绪
    Do While player.playState <> 3 And player.playState <> 1
        WScript.Sleep 100 ' 每100毫秒检查一次状态
    Loop

    If Err.Number <> 0 Then
        WScript.Echo "播放出错：" & Err.Description
        Err.Clear
    End If

    ' 播放中
    Do While player.playState = 3 '3表示正在播放
        ' 弹出消息框，让用户选择操作
        Dim userChoice
        userChoice = MsgBox("正在播放：" & songs(currentSongIndex) & vbCrLf & _
                            "点【是】-> 播放【上一曲】" & vbCrLf & _
                            "点【否】-> 播放【下一曲】" & vbCrLf & _
                            "点【取消】-> 退出【播放器】", _
                            vbYesNoCancel + vbQuestion, "VBS音乐播放器V1")
        If userChoice = vbYes Then
            ' 上一首
            If currentSongIndex > 0 Then
                currentSongIndex = currentSongIndex - 1
            Else
                WScript.Echo "已经是第一首。"
            End If
            player.controls.stop ' 停止当前播放
            Exit Do
        ElseIf userChoice = vbNo Then
            ' 下一首
            currentSongIndex = currentSongIndex + 1
            ' 检查是否超出数组范围
            If currentSongIndex > UBound(songs) Then
                currentSongIndex = 0 '回到第一首
                WScript.Echo "播放到最后一首，现在回到第一首。" '显示信息
            End If
            player.controls.stop ' 停止当前播放
            Exit Do
        ElseIf userChoice = vbCancel Then
            player.controls.stop
            player.close
            WScript.Quit
        End If
        ' 循环等待当前歌曲播放结束
        Do While player.playState = 3
            WScript.Sleep 100
        Loop
    Loop

    ' 如果播放状态不是停止状态，则停止播放
    If player.playState <> 1 Then
        player.controls.stop
    End If
Loop

On Error Goto 0 ' 关闭错误处理

' 释放资源
player.close
Set player = Nothing
Set fso = Nothing

后来发现这个配置文件放到当前目录，一旦歌曲文件夹位置变动，或者播放器位置变动，所有还得跟着再变一遍，而且这个配置文件（config.ini）有可能会被误删除，不符合我懒人的习惯啊，于是又改了一遍，VBS音乐播放器V2.vbs代码如下：

' 创建 FileSystemObject 和 WMPlayer 对象
Set fso = CreateObject("Scripting.FileSystemObject")
Set player = CreateObject("WMPlayer.OCX")
Set shell = CreateObject("WScript.Shell")

' 注册表路径
Dim configRegPath
configRegPath = "HKEY_CURRENT_USER\Software\YsVbsMusicPlayer\Config\"

' 从注册表中读取音乐文件夹路径、当前歌曲索引和音乐总数
Dim musicFolderPath, currentSongIndex, totalSongCount

' 检查并读取注册表项，若不存在则进行初始化
On Error Resume Next
musicFolderPath = shell.RegRead(configRegPath & "MusicFolderPath")
If Err.Number <> 0 Then
    musicFolderPath = ""
    Err.Clear
End If

currentSongIndex = shell.RegRead(configRegPath & "CurrentSongIndex")
If Err.Number <> 0 Then
    currentSongIndex = 0
    Err.Clear
End If

totalSongCount = shell.RegRead(configRegPath & "TotalSongCount")
If Err.Number <> 0 Then
    totalSongCount = 0
    Err.Clear
End If
On Error Goto 0

' 先弹出音乐路径输入的对话框，默认填写调取配置文件中的路径
Do
    musicFolderPath = InputBox(" 请看下面输入框中的音乐文件夹路径"& vbCrLf &""& vbCrLf &" 是否正确？如需更换，请输入新路径"& vbCrLf &""& vbCrLf &" 如果没问题，直接点确定开始播放。", "音乐路径输入", musicFolderPath)
    If musicFolderPath = "" Then
        WScript.Quit
    Else
        Exit Do
    End If
Loop

If Not fso.FolderExists(musicFolderPath) Then
    Do
        WScript.Echo "音乐文件夹路径不存在，请输入正确的音乐文件夹路径。"
        Do
            musicFolderPath = InputBox("请输入有效的MP3音乐文件夹路径", "音乐路径输入")
            If musicFolderPath = "" Then
                WScript.Quit
            Else
                Exit Do
            End If
        Loop
    Loop Until fso.FolderExists(musicFolderPath)
End If

' 检查是否有 MP3 文件
Dim hasMP3Files
hasMP3Files = False
If fso.FolderExists(musicFolderPath) Then
    Dim newTotalSongCount
    newTotalSongCount = 0
    For Each file In fso.GetFolder(musicFolderPath).Files
        If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
            hasMP3Files = True
            newTotalSongCount = newTotalSongCount + 1
        End If
    Next
    If newTotalSongCount <> totalSongCount Then
        ' 音乐数量有变动，重新初始化
        currentSongIndex = 0
        totalSongCount = newTotalSongCount
    End If
End If

If Not hasMP3Files Then
    Do
        WScript.Echo "指定路径下没有 MP3 文件，请重新输入。"
        Do
            musicFolderPath = InputBox("请输入包含MP3文件的音乐文件夹路径", "音乐路径输入")
            If musicFolderPath = "" Then
                WScript.Quit
            Else
                Exit Do
            End If
        Loop
        hasMP3Files = False
        If fso.FolderExists(musicFolderPath) Then
            Dim newTotalSongCount2
            newTotalSongCount2 = 0
            For Each file In fso.GetFolder(musicFolderPath).Files
                If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
                    hasMP3Files = True
                    newTotalSongCount2 = newTotalSongCount2 + 1
                End If
            Next
            If newTotalSongCount2 <> totalSongCount Then
                ' 音乐数量有变动，重新初始化
                currentSongIndex = 0
                totalSongCount = newTotalSongCount2
            End If
        End If
    Loop Until hasMP3Files
End If

' 更新注册表
shell.RegWrite configRegPath & "MusicFolderPath", musicFolderPath, "REG_SZ"
shell.RegWrite configRegPath & "TotalSongCount", totalSongCount, "REG_DWORD"
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"

' 获取文件夹对象
Set musicFolder = fso.GetFolder(musicFolderPath)

' 初始化歌曲数组
Dim songs()
ReDim songs(-1)

' 遍历文件夹，筛选 MP3 文件
For Each file In musicFolder.Files
    If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
        ' 动态扩展数组以保存新的歌曲名称
        ReDim Preserve songs(UBound(songs) + 1)
        ' 添加当前文件的基本名称到数组
        songs(UBound(songs)) = fso.GetBaseName(file.Name)
    End If
Next

If UBound(songs) < 0 Then
    WScript.Echo "没有找到 MP3 文件，请检查路径。"
    WScript.Quit
End If
On Error Resume Next
Do While True
    player.URL = musicFolderPath & "\" & songs(currentSongIndex) & ".mp3"
    player.settings.setMode "loop", True

    Do While player.playState <> 3 And player.playState <> 1
        WScript.Sleep 100
    Loop

    If Err.Number <> 0 Then
        WScript.Echo "播放出错：" & Err.Description
        Err.Clear
    End If

    Do While player.playState = 3
        Dim userChoice
        userChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
                            "点【是】-> 播放【上一曲】" & vbCrLf & _
                            "点【否】-> 播放【下一曲】" & vbCrLf & _
                            "点【取消】-> 退出【播放器】", _
                            vbYesNoCancel + vbQuestion, "VBS音乐播放器V2")
        If userChoice = vbYes Then
            If currentSongIndex > 0 Then
                currentSongIndex = currentSongIndex - 1
            Else
                WScript.Echo "亲，这是已经是第一首咯。"
            End If
            player.controls.stop
            Exit Do
        ElseIf userChoice = vbNo Then
            currentSongIndex = currentSongIndex + 1
            If currentSongIndex > UBound(songs) Then
                currentSongIndex = 0
                WScript.Echo "亲，这是最后一首咯，现在从头开始播放。"
            End If
            player.controls.stop
            Exit Do
        ElseIf userChoice = vbCancel Then
            player.controls.stop
            player.close
            ' 更新注册表
            shell.RegWrite configRegPath & "MusicFolderPath", musicFolderPath, "REG_SZ"
            shell.RegWrite configRegPath & "TotalSongCount", totalSongCount, "REG_DWORD"
            shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
            WScript.Quit
        End If
        Do While player.playState = 3
            WScript.Sleep 100
        Loop
    Loop

    If player.playState <> 1 Then
        player.controls.stop
    End If
Loop

On Error Goto 0

' 释放资源
player.close
Set player = Nothing
Set fso = Nothing
Set shell = Nothing

现在好了，将配置文件直接写进注册表中就省事了，以后无论播放器放在哪儿都行了，而且还增加了路径和曲目检测，感觉高大上了那么一点点，但是不能实现循环播放歌曲实在是别扭啊，于是乎，不安分的我又开始了折腾了，VBS音乐播放器V3.vbs代码如下：

Set fso = CreateObject("Scripting.FileSystemObject")
Set player = CreateObject("WMPlayer.OCX")
Set shell = CreateObject("WScript.Shell")
Dim configRegPath
configRegPath = "HKEY_CURRENT_USER\Software\YsVbsMusicPlayer\Config\"
Dim musicFolderPath, currentSongIndex, totalSongCount
On Error Resume Next
musicFolderPath = shell.RegRead(configRegPath & "MusicFolderPath")
If Err.Number <> 0 Then
    musicFolderPath = ""
    Err.Clear
End If

currentSongIndex = shell.RegRead(configRegPath & "CurrentSongIndex")
If Err.Number <> 0 Then
    currentSongIndex = 0
    Err.Clear
End If

totalSongCount = shell.RegRead(configRegPath & "TotalSongCount")
If Err.Number <> 0 Then
    totalSongCount = 0
    Err.Clear
End If
On Error Goto 0
Do
    musicFolderPath = InputBox(" 请看下面输入框中的音乐文件夹路径"& vbCrLf &""& vbCrLf &" 是否正确？例如：D:\我的音乐"& vbCrLf &""& vbCrLf &" 如果没问题，直接点确定开始播放。", "音乐路径输入 - 轶软VBS音乐播放器V3", musicFolderPath)
    If musicFolderPath = "" Then
        WScript.Quit
    Else
        Exit Do
    End If
Loop

If Not fso.FolderExists(musicFolderPath) Then
    Do
        WScript.Echo "音乐文件夹路径不存在，请输入正确的音乐文件夹路径。"
        Do
            musicFolderPath = InputBox(" 您输入的音乐文件夹路径不对哦"& vbCrLf &""& vbCrLf &" 请重新检查，例如：D:\我的音乐"& vbCrLf &""& vbCrLf &" 输入好后，直接点确定开始播放。", "音乐路径输入 - 轶软VBS音乐播放器V3")
            If musicFolderPath = "" Then
                WScript.Quit
            Else
                Exit Do
            End If
        Loop
    Loop Until fso.FolderExists(musicFolderPath)
End If
Dim hasMP3Files
hasMP3Files = False
If fso.FolderExists(musicFolderPath) Then
    Dim newTotalSongCount
    newTotalSongCount = 0
    For Each file In fso.GetFolder(musicFolderPath).Files
        If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
            hasMP3Files = True
            newTotalSongCount = newTotalSongCount + 1
        End If
    Next
    If newTotalSongCount <> totalSongCount Then
        currentSongIndex = 0
        totalSongCount = newTotalSongCount
    End If
End If
If Not hasMP3Files Then
    Do
        WScript.Echo "指定路径下没有MP3文件，请重新输入。"
        Do
            musicFolderPath = InputBox("请输入包含MP3文件的音乐文件夹路径", "音乐路径输入")
            If musicFolderPath = "" Then
                WScript.Quit
            Else
                Exit Do
            End If
        Loop
        hasMP3Files = False
        If fso.FolderExists(musicFolderPath) Then
            Dim newTotalSongCount2
            newTotalSongCount2 = 0
            For Each file In fso.GetFolder(musicFolderPath).Files
                If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
                    hasMP3Files = True
                    newTotalSongCount2 = newTotalSongCount2 + 1
                End If
            Next
            If newTotalSongCount2 <> totalSongCount Then
                currentSongIndex = 0
                totalSongCount = newTotalSongCount2
            End If
        End If
    Loop Until hasMP3Files
End If
shell.RegWrite configRegPath & "MusicFolderPath", musicFolderPath, "REG_SZ"
shell.RegWrite configRegPath & "TotalSongCount", totalSongCount, "REG_DWORD"
shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
Set musicFolder = fso.GetFolder(musicFolderPath)
Dim songs()
ReDim songs(-1)
For Each file In musicFolder.Files
    If LCase(fso.GetExtensionName(file.Name)) = "mp3" Then
        ReDim Preserve songs(UBound(songs) + 1)
        songs(UBound(songs)) = fso.GetBaseName(file.Name)
    End If
Next
If UBound(songs) < 0 Then
    WScript.Echo "没有找到MP3文件，请检查路径。"
    WScript.Quit
End If
On Error Resume Next
Do While True
    player.URL = musicFolderPath & "\" & songs(currentSongIndex) & ".mp3"
    player.settings.setMode "loop", True

    Do While player.playState <> 3 And player.playState <> 1
        WScript.Sleep 100
    Loop
    If Err.Number <> 0 Then
        WScript.Echo "播放出错：" & Err.Description
        Err.Clear
    End If

    Do While player.playState = 3
        Dim userChoice
        userChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
                            "点【是】-> 播放【上一曲】" & vbCrLf & _
                            "点【否】-> 播放【下一曲】" & vbCrLf & _
                            "点【取消】-> 选择播放模式", _
                            vbYesNoCancel + vbQuestion, (currentSongIndex + 1) & "." & songs(currentSongIndex) & " - " & "轶软VBS音乐播放器V3")
        If userChoice = vbYes Then
    If currentSongIndex > 0 Then
        currentSongIndex = currentSongIndex - 1
    Else
        WScript.Echo "亲，这是已经是第一首咯。"
    End If
    shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
    player.controls.stop
    Exit Do
    ElseIf userChoice = vbNo Then
    currentSongIndex = currentSongIndex + 1
    If currentSongIndex > UBound(songs) Then
        currentSongIndex = 0
        WScript.Echo "亲，这是最后一首咯，现在从头开始播放。"
    End If
    shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
    player.controls.stop
    Exit Do
        ElseIf userChoice = vbCancel Then
            Dim loopChoice
            loopChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
                                "点【是】-> 全曲循环播放" & vbCrLf & _
                                "点【否】-> 返回主界面" & vbCrLf & _
                                "点【取消】-> 退出播放器", _
                        vbYesNoCancel + vbQuestion, "音乐循环模式 - 轶软VBS音乐播放器V3")
            If loopChoice = vbYes Then
                player.settings.setMode "loop", False
                Do While True
                    player.URL = musicFolderPath & "\" & songs(currentSongIndex) & ".mp3"
                    Do While player.playState <> 3 And player.playState <> 1
                        WScript.Sleep 100
                    Loop
                    If Err.Number <> 0 Then
                        WScript.Echo "播放出错：" & Err.Description
                        Err.Clear
                    End If
                    Do While player.playState = 3
                        WScript.Sleep 100
                    Loop
                    currentSongIndex = currentSongIndex + 1
                    If currentSongIndex > UBound(songs) Then
                        currentSongIndex = 0
                    End If
                    shell.RegWrite configRegPath & "CurrentSongIndex", currentSongIndex, "REG_DWORD"
                Loop
            ElseIf loopChoice = vbNo Then
                player.settings.setMode "loop", True
                Exit Do
            ElseIf loopChoice = vbCancel Then
                WScript.Quit
            End If
        End If
        Do While player.playState = 3
            WScript.Sleep 100
        Loop
    Loop
    If player.playState <> 1 Then
        player.controls.stop
    End If
Loop
On Error Goto 0
player.close
Set player = Nothing
Set fso = Nothing
Set shell = Nothing