[问题求助] 求助VBS播放器：全曲循环播放不能显示界面的问题

yiyue7

下面是一个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 &" 是否正确？如需更换，请输入新路径"& 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
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
            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
            Dim loopChoice
            loopChoice = MsgBox("正在播放：" & (currentSongIndex + 1) & "." & songs(currentSongIndex) & vbCrLf & _
                                "点【是】-> 全曲循环播放" & vbCrLf & _
                                "点【否】-> 返回主界面" & vbCrLf & _
                                "点【取消】-> 退出播放器", _
                        vbYesNoCancel + vbQuestion, "音乐循环模式")
            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
复制代码

以上就是完整代码了，急用拜托。

jyswjjgdwtdtj

回复 8# yiyue7


   自制播放器可以考虑html5 像chrome可以吧网页打包为本地应用 h5的视频框架也挺多的 方便 教程也多

yiyue7

回复 7# aloha20200628


    你好，只是单纯的听歌玩而已，我做的这种脚本肯定没有播放器软件功能齐全的，纯属娱乐，感谢你的回复。

aloha20200628

回复 6# yiyue7

一楼代码用vbs播放mp3，是在调用系统内置的wmplayer插件，为何楼主不直接用系统内置的wmplayer播放指定的mp3播放列表文件呢？例如以下代码（存为 test.bat 运行），代码中的d3变量（即mp3文件所在目录）以及wmplayer.exe的路径均由楼主自定义...

@echo off &set "d3=d:\mp3"
dir /b/s/a-d "%d3%\*.mp3">"mp3播放列表.m3u"
start "" "C:\Program Files\Windows Media Player\wmplayer.exe" "%cd%\mp3播放列表.m3u"
exit/b
复制代码

yiyue7

回复 5# jyswjjgdwtdtj


    算了，不整了，就这么用吧，hta界面和控制显示有的会有问题，兼容性问题，如果彻底还不如py呢

jyswjjgdwtdtj

回复 4# yiyue7


   用vbs实现交互实在不是一个容易的事 考虑用hta做个小应用？

yiyue7

回复 3# jyswjjgdwtdtj


    你好，如果方便的话，您能帮我改一下吗？deepseek写的还是欠佳啊，do循环那个还有循环播放不显示，我也不知道怎么改了，您能给个完整的可以运行的吗，谢谢了

jyswjjgdwtdtj

vbs是单线程的 或许可以试试htmlfile的settimeout函数 用回调来弹出一个对话框 不过最方便的还是用cscript打开 想结束进程直接把控制台窗口关了就行使控制台窗口显示或者不显示可以用wshshell的exec方法运行powershell.exe -windowstyle hidden或者normal来调整 当然以上都不美观 想要自用到是够了
同时你的代码似乎有点臃肿诶

Do
            musicFolderPath = InputBox("请输入包含MP3文件的音乐文件夹路径", "音乐路径输入")
            If musicFolderPath = "" Then
                WScript.Quit
            Else
                Exit Do
            End If
        Loop
复制代码

套个循环是何意？

yiyue7

能给优化一下就更好了，比我我想的是，循环播放完一首后，自动关闭，弹出界面播放第二首，这样界面就能同步显示歌曲名称了，如果不能实现，就在循环播放时弹出显示操作界面吧，现在必须得到进程去关闭才行，有点麻烦啊